subroutine bjac(ny,t,y,ml,mu,jac,nrowj) c c Copyright INRIA INCLUDE '../stack.h' integer iadr,sadr c double precision y(ny),jac(nrowj,ny),t(*) common/ierode/iero c logical allowptr integer vol,tops,nordre data nordre/2/,mlhs/1/ c iadr(l)=l+l-1 sadr(l)=(l/2)+1 c iero=0 mrhs=2 c ilp=iadr(lstk(top)) il=istk(ilp+nordre) c tops=istk(il) ils=iadr(lstk(tops)) c if(istk(ils).eq.10) then c cas d'un simulateur en fortran call fjac(ny,t,y,ml,mu,jac,nrowj) return endif c c transfert des arguments d'entree minimaux du simulateur c la valeur de ces arguments vient du contexte fortran (liste d'appel) c+ call ftob(t,1,istk(il+1)) call ftob(y,ny,istk(il+2)) c+ c c c recuperation de l'adresse du simulateur fin=lstk(tops) c if(istk(ils).eq.15) then c cas ou le simulateur est decrit par une liste nelt=istk(ils+1) l=sadr(ils+3+nelt) ils=ils+2 c c recuperation de l'adresse du simulateur fin=l c c gestion des parametres supplementaires du simulateur c proviennent du contexte (elements de la liste c decrivant le simulateur c nelt=nelt-1 if(nelt.eq.0) goto 40 l=l+istk(ils+1)-istk(ils) vol=istk(ils+nelt+1)-istk(ils+1) if(top+1+nelt.ge.bot) then call error(18) if(err.gt.0) goto 9999 endif err=lstk(top+1)+vol-lstk(bot) if(err.gt.0) then call error(17) if(err.gt.0) goto 9999 endif call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1) do 11 i=1,nelt top=top+1 lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i) 11 continue mrhs=mrhs+nelt endif 40 continue c c execution de la macro definissant le simulateur c iero=0 pt=pt+1 if(pt.gt.psiz) then call error(26) goto 9999 endif ids(1,pt)=lhs ids(2,pt)=rhs rstk(pt)=1001 lhs=mlhs rhs=mrhs niv=niv+1 fun=0 c icall=5 include '../callinter.h' c 200 lhs=ids(1,pt) rhs=ids(2,pt) pt=pt-1 c+ c transfert des variables de sortie vers fortran if(ml.gt.0.or.mu.gt.0) then mm=ml+mu+1 call btofm(jac,nrowj,mm,ny) else nnn=ny*ny call btof(jac,nnn) endif if(err.gt.0) goto 9999 c+ niv=niv-1 return c 9999 continue if(err1.gt.0) then lhs=ids(1,pt) rhs=ids(2,pt) pt=pt-1 fun=0 endif iero=1 niv=niv-1 return end