main
|
Last change
on this file was ea777aa, checked in by Alex Wilton <awilton@…>, 3 years ago |
|
Moved examples, include, build_default.properties, common.xml, and README out from dev.civl.com into the root of the repo.
git-svn-id: svn://vsl.cis.udel.edu/civl/trunk@5704 fb995dde-84ed-4084-dfe6-e5aef3e2452c
|
-
Property mode
set to
100755
|
|
File size:
1018 bytes
|
| Line | |
|---|
| 1 | subroutine fcvjtimes (v,fjv,tt,y,fy,h,ipar,rpar,work,ier)
|
|---|
| 2 | c
|
|---|
| 3 | c Compute Jacobian Vetor product FJV
|
|---|
| 4 | c approximated by 1st-order fd quotient
|
|---|
| 5 | c
|
|---|
| 6 | real v(*), fjv(*), tt, y(*), fy(*), h, rpar(1), work(*)
|
|---|
| 7 |
|
|---|
| 8 | INCLUDE 'SIZE'
|
|---|
| 9 | INCLUDE 'INPUT'
|
|---|
| 10 | INCLUDE 'CVODE'
|
|---|
| 11 |
|
|---|
| 12 | integer*8 ipar(1)
|
|---|
| 13 |
|
|---|
| 14 | if (nio.eq.0.and.loglevel.gt.2)
|
|---|
| 15 | $ write(6,*) 'fcvjtimes'
|
|---|
| 16 |
|
|---|
| 17 | ifdqj = .true.
|
|---|
| 18 |
|
|---|
| 19 | ! compute weighted rms norm ||v||
|
|---|
| 20 | call fcvgeterrweights(work,ier)
|
|---|
| 21 | sum = 0.0
|
|---|
| 22 | do i = 1,cv_nlocal
|
|---|
| 23 | dnorm = v(i)*work(i)
|
|---|
| 24 | sum = sum + dnorm*dnorm
|
|---|
| 25 | enddo
|
|---|
| 26 | sum = sqrt(glsum(sum,1)/cv_nglobal)
|
|---|
| 27 | sig = 1./sum
|
|---|
| 28 | sig = cv_sigs * sig
|
|---|
| 29 |
|
|---|
| 30 | ! set FJV = f(t, y + sigs*v/||v||)
|
|---|
| 31 | do i = 1,cv_nlocal
|
|---|
| 32 | work(i) = y(i) + sig*v(i)
|
|---|
| 33 | enddo
|
|---|
| 34 | call fcvfun(tt,work,fjv,ipar,rpar,ier)
|
|---|
| 35 |
|
|---|
| 36 | siginv = 1./sig
|
|---|
| 37 | do i = 1,cv_nlocal
|
|---|
| 38 | fjv(i) = fjv(i)*siginv - fy(i)*siginv
|
|---|
| 39 | enddo
|
|---|
| 40 |
|
|---|
| 41 | ifdqj = .false.
|
|---|
| 42 | ier = 0
|
|---|
| 43 |
|
|---|
| 44 | return
|
|---|
| 45 | end
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
