Line data Source code
1 25299 : subroutine decsol_done(n,fjac,ldjac,fmas,ldmas,mlmas,mumas,
2 : & m1,m2,nm1,fac1,e1_1D,lde1,ip1,ak,ier,ijob,calhes,iphes,
3 : & mle,mue,mbjac,mbb,mdiag,mdiff,mbdiag,
4 : & decsol,decsols,decsolblk,
5 : & caller_id, nvar, nz, lblk, dblk, ublk,
6 25299 : & sparse_jac,nzmax,isparse,ia,ja,sa,
7 : & lrd,rpar_decsol,lid,ipar_decsol)
8 : implicit none
9 : interface
10 : #include "mtx_decsol.dek"
11 : #include "mtx_decsols.dek"
12 : #include "mtx_decsolblk.dek"
13 : end interface
14 : integer, intent(in) :: caller_id, nvar, nz
15 : real(dp), dimension(:), pointer, intent(inout) :: lblk, dblk, ublk ! =(nvar,nvar,nz)
16 : integer :: ia(:) ! (n+1)
17 : integer :: ja(:) ! (nzmax)
18 : integer :: n, ldjac, ldmas, mlmas, mumas, m1, m2, nm1, lde1, ier, ijob
19 : integer :: mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag, nzmax, isparse, lrd, lid
20 : real(dp) :: sparse_jac(:) ! (nzmax)
21 : real(dp) :: sa(:) ! (nzmax)
22 : real(dp), intent(inout), pointer :: rpar_decsol(:) ! (lrd)
23 : integer, intent(inout), pointer :: ipar_decsol(:) ! (lid)
24 : real(dp) :: fac1, fjac(ldjac,n), fmas(ldmas,nm1)
25 : logical :: calhes
26 : integer :: iphes(n)
27 : integer, pointer :: ip1(:) ! (nm1)
28 : real(dp), pointer :: e1_1D(:) ! =(lde1,nm1)
29 : real(dp), pointer :: ak(:)
30 :
31 : !write(*,*) 'decsol_done ijob', ijob
32 :
33 :
34 25299 : ier = 0
35 25299 : if (nvar > 0) then
36 : call decsolblk(
37 0 : & 2,caller_id,nvar,nz,lblk,dblk,ublk,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
38 0 : return
39 : end if
40 :
41 25299 : GOTO (1,2,3,4,5,6,55,8,9,55,11,12,13,14,15), ijob
42 : !
43 : ! -----------------------------------------------------------
44 : !
45 : 1 continue
46 : ! --- b=identity, jacobian a full matrix
47 17412 : call decsol(2,n,lde1,e1_1D,n,n,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
48 17412 : return
49 : !
50 : ! -----------------------------------------------------------
51 : !
52 : 8 continue
53 : ! --- b=identity, jacobian a sparse matrix
54 : !write(*,*) 'decsol_done call decsols'
55 0 : call decsols(2,n,nzmax,ia,ja,sa,ak,lrd,rpar_decsol,lid,ipar_decsol,ier)
56 : !write(*,*) 'back decsols'
57 0 : return
58 : !
59 : ! -----------------------------------------------------------
60 : !
61 : 11 continue
62 : ! --- b=identity, jacobian a full matrix, second order
63 0 : call decsol(2,nm1,lde1,e1_1D,nm1,nm1,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
64 0 : return
65 : !
66 : ! -----------------------------------------------------------
67 : !
68 : 2 continue
69 : ! --- b=identity, jacobian a banded matrix
70 7887 : call decsol(2,n,lde1,e1_1D,mle,mue,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
71 7887 : return
72 : !
73 : ! -----------------------------------------------------------
74 : !
75 : 12 continue
76 : ! --- b=identity, jacobian a banded matrix, second order
77 0 : call decsol(2,nm1,lde1,e1_1D,mle,mue,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
78 0 : return
79 : !
80 : ! -----------------------------------------------------------
81 : !
82 : 3 continue
83 : ! --- b is a banded matrix, jacobian a full matrix
84 0 : call decsol(2,n,lde1,e1_1D,n,n,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
85 0 : return
86 : !
87 : ! -----------------------------------------------------------
88 : !
89 : 9 continue
90 : ! --- b is a banded matrix, jacobian a sparse matrix
91 0 : call decsols(2,n,nzmax,ia,ja,sa,ak,lrd,rpar_decsol,lid,ipar_decsol,ier)
92 0 : return
93 : !
94 : ! -----------------------------------------------------------
95 : !
96 : 13 continue
97 : ! --- b is a banded matrix, jacobian a full matrix, second order
98 : GOTO 5
99 : !
100 : ! -----------------------------------------------------------
101 : !
102 : 4 continue
103 : ! --- b is a banded matrix, jacobian a banded matrix
104 0 : call decsol(2,n,lde1,e1_1D,mle,mue,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
105 0 : return
106 : !
107 : ! -----------------------------------------------------------
108 : !
109 : 14 continue
110 : ! --- b is a banded matrix, jacobian a banded matrix, second order
111 : GOTO 12
112 : !
113 : ! -----------------------------------------------------------
114 : !
115 : 5 continue
116 : ! --- b is a full matrix, jacobian a full matrix
117 0 : call decsol(2,n,lde1,e1_1D,n,n,ak,ip1,lrd,rpar_decsol,lid,ipar_decsol,ier)
118 0 : return
119 : !
120 : ! -----------------------------------------------------------
121 : !
122 : 15 continue
123 : ! --- b is a full matrix, jacobian a full matrix, second order
124 : GOTO 5
125 : !
126 : ! -----------------------------------------------------------
127 : !
128 : 6 continue
129 : ! --- b is a full matrix, jacobian a banded matrix
130 : ! --- this option is not provided
131 : return
132 : !
133 : ! -----------------------------------------------------------
134 : !
135 : 55 continue
136 0 : write(*,*) 'decsol_done: invalid ijob', ijob
137 0 : call mesa_error(__FILE__,__LINE__) ! decsol_done
138 : end subroutine decsol_done
|
