c----------------------------------------------------------------------- c these are the subroutines for the c c CUSP c ODE of dimension 96 c c----------------------------------------------------------------------- subroutine prob(problm,neqn,ndisc,t,ijac,mljac,mujac) IMPLICIT REAL*8 (A-H,O-Z) character*(*) problm integer neqn,ndisc,ijac,mljac,mujac,nnerv double precision t(0:*),diffus,anerv COMMON/NERVES/NNERV COMMON/DIFFCOEF/DIFFUS problm = 'cusp' neqn = 96 ndisc = 0 t(0) = 0d0 t(1) = 1.10d0 ijac = 0 mljac = 3 mujac = 3 NNERV=32 anerv=dble(NNERV*NNERV) DIFFUS=1.D0*anerv/144.D0 return end c----------------------------------------------------------------------- subroutine init(neqn,y) integer neqn, inerv, nnerv double precision y(neqn), anerv,del COMMON/NERVES/NNERV ANERV=dble(NNERV) DEL=2.D0*3.14159265358979324D0/ANERV DO INERV=1,NNERV Y(3*INERV-2)=0.D0 Y(3*INERV-1)=-2.D0*COS(INERV*DEL) Y(3*INERV)=2.D0*SIN(INERV*DEL) ENDDO return end c----------------------------------------------------------------------- SUBROUTINE feval(N,T,Y,DF,IERR,RPAR,IPAR) IMPLICIT double precision (A-H,O-Z) double precision Y(N),DF(N) COMMON/NERVES/NNERV COMMON/DIFFCOEF/DIFFUS c----------- DO 25 INERV=1,NNERV X=Y(3*INERV-2) A=Y(3*INERV-1) B=Y(3*INERV) IF(INERV.EQ.1)THEN XRIGHT=Y(3*NNERV-2) ARIGHT=Y(3*NNERV-1) BRIGHT=Y(3*NNERV) ELSE XRIGHT=Y(3*INERV-5) ARIGHT=Y(3*INERV-4) BRIGHT=Y(3*INERV-3) END IF IF(INERV.EQ.NNERV)THEN XLEFT=Y(1) ALEFT=Y(2) BLEFT=Y(3) ELSE XLEFT=Y(3*INERV+1) ALEFT=Y(3*INERV+2) BLEFT=Y(3*INERV+3) END IF XDOT=-10000.D0*(B+X*(A+X*X)) U=(X-0.7D0)*(X-1.3D0) V=U/(U+0.1D0) ADOT=B+0.07D0*V BDOT=(1.D0*(1.D0-A*A)*B-A)-0.4D0*X+0.035D0*V DF(3*INERV-2)=XDOT+DIFFUS*(XLEFT-2.D0*X+XRIGHT) DF(3*INERV-1)=ADOT+DIFFUS*(ALEFT-2.D0*A+ARIGHT) DF(3*INERV) =BDOT+DIFFUS*(BLEFT-2.D0*B+BRIGHT) 25 CONTINUE RETURN END c----------------------------------------------------------------------- subroutine jeval(N,X,Y,DFY,MEBND,IERR,RPAR,IPAR) integer N, MEBND,IERR,IPAR double precision Y(N),DFY(MEBND,N),X,RPAR RETURN END c----------------------------------------------------------------------- subroutine solut(neqn,true) integer neqn double precision true(neqn) c c true(1)=-1.335038235173363825d0 true(2)=-0.141920661299976116d0 true(3)=2.189999851122752954d0 true(4)=-1.290165517136865728d0 true(5)=0.292210513241939329d0 true(6)=2.524498007953815718d0 true(7)=-1.206268463248866837d0 true(8)=0.702876002804259450d0 true(9)=2.603037671957832137d0 true(10)=-1.081173370722796200d0 true(11)=1.054547339698463687d0 true(12)=2.403900155664309457d0 true(13)=-0.922551477213655165d0 true(14)=1.326991956338080918d0 true(15)=2.009305096775369514d0 true(16)=-0.743049818521982534d0 true(17)=1.516881284521938182d0 true(18)=1.537256339189765457d0 true(19)=-0.555201077072863929d0 true(20)=1.632603197056899916d0 true(21)=1.077437487481636876d0 true(22)=-0.369158363066035655d0 true(23)=1.687674223256960258d0 true(24)=0.673204001909134905d0 true(25)=-0.192671593795137051d0 true(26)=1.695724385342398648d0 true(27)=0.333758479535656796d0 true(28)=-0.030615931836238017d0 true(29)=1.667262708083148298d0 true(30)=0.050978698243957534d0 true(31)=0.117513584875619235d0 true(32)=1.607508563419502269d0 true(33)=-0.190604748914752998d0 true(34)=0.259898961244445617d0 true(35)=1.514823442340568479d0 true(36)=-0.411323787318084589d0 true(37)=0.411809029672400558d0 true(38)=1.379804789392094260d0 true(39)=-0.638121744946811883d0 true(40)=0.590441346230457812d0 true(41)=1.185589061664514451d0 true(42)=-0.905945997151089418d0 true(43)=0.803741778414404449d0 true(44)=0.910756427168161885d0 true(45)=-1.251345457775128863d0 true(46)=1.037877442048335801d0 true(47)=0.545036626743780133d0 true(48)=-1.683821753687386274d0 true(49)=1.239043542405442416d0 true(50)=0.169981336507011738d0 true(51)=-2.112958754094543822d0 true(52)=1.406385681620871097d0 true(53)=-0.235380986562835855d0 true(54)=-2.450796096861493262d0 true(55)=1.524334200774267799d0 true(56)=-0.633461856049010260d0 true(57)=-2.576413161518578492d0 true(58)=1.588649099727842025d0 true(59)=-0.986582203794960052d0 true(60)=-2.442161394270367795d0 true(61)=1.606022353430074771d0 true(62)=-1.269240297385074114d0 true(63)=-2.104018859237057304d0 true(64)=1.588788794126354791d0 true(65)=-1.473056296837721718d0 true(66)=-1.670122571729852451d0 true(67)=1.549115780473624505d0 true(68)=-1.603417743271582846d0 true(69)=-1.233609811984700428d0 true(70)=1.495889929838369103d0 true(71)=-1.672805947347039028d0 true(72)=-0.844976238622025912d0 true(73)=1.434154221021214460d0 true(74)=-1.695067644864453216d0 true(75)=-0.518751841694241591d0 true(76)=1.365334914988092461d0 true(77)=-1.681659890115195530d0 true(78)=-0.249120054639391870d0 true(79)=1.286403800980685275d0 true(80)=-1.639285126097438457d0 true(81)=-0.019980596158691364d0 true(82)=1.184974025791693888d0 true(83)=-1.567910985925968939d0 true(84)=0.194039539947058944d0 true(85)=1.011140518164431143d0 true(86)=-1.455860565434940201d0 true(87)=0.436843623543739620d0 true(88)=-1.349821324547813729d0 true(89)=-1.223845158570813537d0 true(90)=0.809099908070360854d0 true(91)=-1.355008974443540401d0 true(92)=-0.926131110369012061d0 true(93)=1.232945832067604962d0 true(94)=-1.352261107347051711d0 true(95)=-0.559070645046367311d0 true(96)=1.716745798614099647d0 return end