Add routine for dobs generation for scalars and known derivatives

src/aderrors/aderrors_arith.f90

@@ -205,6 +205,52 @@ contains
     return
   end subroutine addobs_d
   
+! ********************************
+! *
+  module subroutine addobs_ds(x, a, der, mns)
+! *
+! ********************************
+    type (uwreal), intent  (inout) :: x
+    type (uwreal), intent  (in)    :: a(:)
+    real (kind=DP), intent (in)    :: der(:), mns
+
+    integer        :: no, nid, i, j, is_r, ie_r, &
+         is_s, ie_s, nvt
+
+    no   = size(a)
+    nvt  = 0
+    nid  = 0
+
+    do i = 1, no
+       nvt = nvt + size(a(i)%ivrep)
+       nid = nid + a(i)%nid
+    end do
+    call init_ws(nid,nvt,no)
+    call combine_ids_multi(nid,a)
+    nvt = sum(ws%nrep(1:nid))
+
+    call x%init(nid, ws%nd, ws%nrep, ws%ivrep(1:nvt))
+    x%id(1:nid)    = ws%ids(1:nid)
+    x%nrep(1:nid)  = ws%nrep(1:nid)
+    x%texp(1:nid)  = ws%texp(1:nid)
+    x%ivrep(1:nvt) = ws%ivrep(1:nvt)
+
+    x%mean = mns
+    x%data = 0.0_DP
+    do i = 1, x%neid()
+       call x%get_offset(is_r,ie_r,i,0)
+       do j = 1, no
+          if (ws%map(i,j).ne.0) then 
+             call a(j)%get_offset(is_s,ie_s,ws%map(i,j),0)
+             x%data(is_r:ie_r) = x%data(is_r:ie_r)  + &
+                  der(j) * a(j)%data(is_s:ie_s)
+          end if
+       end do
+    end do
+       
+    return
+  end subroutine addobs_ds
+  
 ! ********************************
 ! *
   module subroutine uwdobs_f(x, a, fn)