File: icsec2.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (58 lines) | stat: -rw-r--r-- 1,837 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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
      subroutine icsec2(indc,nu,tob,obs,cof,ytob,ob,u,
     & c,cy,g,yob,d,itu,dtu,
     & t0,tf,dti,dtf,ermx,iu,nuc,nuv,ilin,nti,ntf,ny,nea,
     & itmx,nex,nob,ntob,ntobi,nitu,ndtu)
c
c
c     critere standard des moindres carres
c
c
c      Cout ponctuel :
c       Parametres d'entree :
c        indc     : 1 si on desire calculer c2,2 si on desire
c                   calculer c2y,c2u
c        tob      : instants de mesure
c        obs      : matrice d'observation
c        cof      : coefficients de ponderation du cout
c        ytob     : valeur de l'etat aux instants d'observation
c        ob       : mesures
c        u(nu)    : controle.Le controle variable est stocke a la
c                   suite du controle suite du constant.
c       Parametres de sortie :
c        indc     : comme pour icsec1
c        c2       : cout
c        c2y(ny,ntob) : derivee de c2 par rapport a y
c        g(nu)  : derivee de c2 par rapport a u
c     Copyright INRIA

c!
      implicit double precision (a-h,o-z)
      dimension tob(ntob),obs(nob,ny),cof(nob,ntob),ytob(ny,ntob),
     &ob(nex,ntob,nob),u(nu),cy(ny,ntob),g(nu),yob(nob,ntob),
     &d(nob),itu(nitu),dtu(ndtu),iu(5)
c
c     critere standard des moindres carres
c
      call dmmul(obs,nob,ytob,ny,yob,nob,nob,ny,ntob)
      if (indc.eq.1) then
         c=0.0d+0
         do 12 i=1,nob
            do 11 j=1,ntob
               do 10 k=1,nex
                  c=c+0.50d+0*cof(i,j)*(yob(i,j)-ob(k,j,i))**2
 10            continue
 11         continue
 12      continue
      else
         do 20 j=1,ntob
            do 25 i=1,nob
               d(i)=0.0d+0
               do 24 k=1,nex
                  d(i)=d(i)+cof(i,j)*(yob(i,j)-ob(k,j,i))
 24            continue
 25         continue
            call dmmul(d,1,obs,nob,cy(1,j),1,1,nob,ny)
 20      continue
      endif

      end