C * * * * * * * * * * * * * * * * * * * * * * * * * C --- DRIVER FOR SEULEX ON BRUSS-2D C * * * * * * * * * * * * * * * * * * * * * * * * * IMPLICIT REAL*8 (A-H,O-Z) C --- PARAMETERS FOR SEULEX (FULL JACOBIAN) PARAMETER (NSD=128,ND=NSD*NSD*2,KM=12,LJAC=1,LMAS=0,LE=1) PARAMETER (LWORK=ND*(LJAC+LMAS+LE+KM+8)+4*KM+20) PARAMETER (LIWORK=2*ND+KM+20) DIMENSION Y(ND),WORK(LWORK),IWORK(LIWORK),ISTAT(20) C -------- END PARAMETER LIST -------- REAL*4 TARRAY(2) EXTERNAL FBRUS,JBRUS,SOLOUT COMMON/TRANS/ALF,NS,NSSQ,NSNSM1,NSM1SQ COMMON /FOURIER/TCOS(512),NF(2),ALPH,NDIM,NSF,NSSQF c ------ FILE DE DONNEES ---------- OPEN(8,FILE='res_seulex') REWIND 8 C ----- DIMENSIONS -------- NS=128 NSSQ=NS*NS NSNSM1=NS*(NS-1) N=2*NSSQ ALF=1.0D-1 ALPH=ALF WRITE(6,*)' NS=',NS,' N=',N,' ALF=',ALF PI=4.0D0*ATAN(1.0D0) NDIM=2 NF(1)=NS NF(2)=NS DO I=1,NS TCOS(I)=2*COS(PI*(I-1)*2.0D0/NS)*ALF*NSSQ END DO NSF=NS NSSQF=NSSQ C --- LOOP FOR DIFFERENT TOLERANCES NTOLMN=2 NTOLMX=10 NTOLDF=4 NRLOOP=(NTOLMX-NTOLMN)*NTOLDF+1 TOLST=0.1D0**NTOLMN TOLFC=0.1D0**(1.D0/NTOLDF) DO 30 NTOL=1,NRLOOP C --- FOR THE USE OF DC_DECSOL_2D.F IJAC=1 MLJAC=0 MUJAC=0 C --- DIFFERENTIAL EQUATION IS IN EXPLICIT FORM IMAS=0 MLMAS=0 MUMAS=0 C --- OUTPUT ROUTINE IS NOT USED DURING INTEGRATION IOUT=0 C --- INITIAL VALUES X=0.0D0 ANS=NS DO J=1,NS YY=(J-1)/ANS DO I=1,NS Y((J-1)*NS+I)=22.D0*YY*(1.D0-YY)**(1.5D0) END DO END DO DO I=1,NS XX=(I-1)/ANS DO J=1,NS Y((J-1)*NS+I+NSSQ)=27.D0*XX*(1.D0-XX)**(1.5D0) END DO END DO C --- REQUIRED TOLERANCE RTOL=TOLST ATOL=RTOL ITOL=0 C --- INITIAL STEP SIZE H=1.0D-4 C --- SET DEFAULT VALUES DO I=1,20 WORK(I)=0.D0 IWORK(I)=0 ISTAT(I)=0 END DO C --- ENDPOINT OF INTEGRATION XEND=1.5D0 IFCN=0 CALL DTIME(TARRAY) DO 20 I=1,2 C --- CALL OF THE SUBROUTINE RADAU5 CALL SEULEX(N,FBRUS,IFCN,X,Y,XEND,H, & RTOL,ATOL,ITOL, & JBRUS,IJAC,MLJAC,MUJAC, & FBRUS,IMAS,MLMAS,MUMAS, & SOLOUT,IOUT, & WORK,LWORK,IWORK,LIWORK,RPAR,IPAR,IDID) C --- PRINT SOLUTION DO J=1,N,267 WRITE (8,*) Y(J) END DO C --- PRINT STATISTICS DO J=14,20 ISTAT(J)=ISTAT(J)+IWORK(J) END DO 20 XEND=XEND+10.D0 CALL DTIME(TARRAY) WRITE(8,*)TARRAY(1) WRITE (8,*)(ISTAT(J),J=14,20) WRITE(6,*)' ***** TOL=',RTOL,' ELAPSED TIME=',TARRAY(1),' ****' WRITE (6,91) (ISTAT(J),J=14,20) 91 FORMAT(' fcn=',I5,' jac=',I4,' step=',I4, & ' accpt=',I4,' rejct=',I3,' dec=',I4, & ' sol=',I5) C -------- NEW TOLERANCE --- TOLST=TOLST*TOLFC IF (TARRAY(1).GT.5000.) STOP c write (6,*) y(1),y(n/2),y(n) 30 CONTINUE STOP END C SUBROUTINE SOLOUT (NR,XOLD,X,Y,RC,LRC,IC,LIC,N,RPAR,IPAR,IRTRN) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION Y(N),RC(LRC),IC(LIC) WRITE (6,99) X,Y(1),Y(N/2),Y(N),NR-1 99 FORMAT(1X,'X =',F5.2,' Y =',3E18.10,' NSTEP =',I4) RETURN END