diff --git a/data/templates/default.rst b/data/templates/default.rst
index 937eb72ae..9ba15f546 100644
--- a/data/templates/default.rst
+++ b/data/templates/default.rst
@@ -1,5 +1,5 @@
-$if(title)$
-$title$
+$if(titleblock)$
+$titleblock$
 
 $endif$
 $for(author)$
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 817fb665d..0c118669b 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -83,13 +83,14 @@ pandocToRST (Pandoc meta blocks) = do
   let render' :: Doc -> Text
       render' = render colwidth
   let subtit = case lookupMeta "subtitle" meta of
-                    Just (MetaBlocks [Plain xs]) -> xs
-                    _                            -> []
+                    Just (MetaBlocks [Plain xs])  -> xs
+                    Just (MetaInlines xs)         -> xs
+                    _                             -> []
   title <- titleToRST (docTitle meta) subtit
   metadata <- metaToJSON opts
                 (fmap render' . blockListToRST)
                 (fmap (stripEnd . render') . inlineListToRST)
-                $ B.deleteMeta "title" $ B.deleteMeta "subtitle" meta
+                meta
   body <- blockListToRST' True $ case writerTemplate opts of
                                       Just _  -> normalizeHeadings 1 blocks
                                       Nothing -> blocks
@@ -105,7 +106,7 @@ pandocToRST (Pandoc meta blocks) = do
               $ defField "toc-depth" (show $ writerTOCDepth opts)
               $ defField "number-sections" (writerNumberSections opts)
               $ defField "math" hasMath
-              $ defField "title" (render Nothing title :: String)
+              $ defField "titleblock" (render Nothing title :: String)
               $ defField "math" hasMath
               $ defField "rawtex" rawTeX metadata
   case writerTemplate opts of
diff --git a/test/Tests/Writers/RST.hs b/test/Tests/Writers/RST.hs
index a1a4510e0..0d5b7c38a 100644
--- a/test/Tests/Writers/RST.hs
+++ b/test/Tests/Writers/RST.hs
@@ -16,6 +16,11 @@ infix 4 =:
      => String -> (a, String) -> TestTree
 (=:) = test (purely (writeRST def . toPandoc))
 
+testTemplate :: (ToString a, ToString c, ToPandoc a) =>
+                String -> String -> (a, c) -> TestTree
+testTemplate t =
+  test (purely (writeRST def{ writerTemplate = Just t }) . toPandoc)
+
 tests :: [TestTree]
 tests = [ testGroup "rubrics"
           [ "in list item" =:
@@ -156,4 +161,7 @@ tests = [ testGroup "rubrics"
               , "Header 2"
               , "--------"]
           ]
+        , testTemplate "$subtitle$\n" "subtitle" $
+          (setMeta "subtitle" ("subtitle" :: Inlines) $ doc $ plain "") =?>
+          ("subtitle" :: String)
         ]