SUBROUTINE JR4FM (XL,YL,SIDEX,SIDEY,NITER,CR,CI,COL,MCPAX,MCPAY) C C COPYRIGHT (C) 1985-1992 BY ART MATRIX. ALL RIGHTS RESERVED. C IMPLICIT REAL*8 (A-H,O-Z) C INTEGER*2 COL(0:MCPAX,0:MCPAY) INTEGER*4 PENP(0:3),PENN(0:3) C COMPLEX*16 Z,A,AZ,B,C,CMCC,D,ALPHA C DATA PENP/1, 2, 3, 4/ DATA PENN/9,10,11,12/ C C*********************************************************************** C*********************************************************************** C CALL DRVID ('FM ',102,2,1,13) C C*********************************************************************** C*********************************************************************** C C = DCMPLX(CR,CI) C CMCC = C - C*C C A = (2 - C)/CMCC B = -(CMCC + 1)/CMCC C ALPHA = 1/( C*C * (B + B + B*B/A) * (2*A*C + B) ) ESC = 4/ABS(ALPHA) ESC = ESC *ESC EPS = .000001/ESC C C*********************************************************************** C*********************************************************************** C DO 2000 IY = 0,MCPAY C Y = YL + (IY*SIDEY)/MCPAY C CALL SHOWIY (10,IY,Y) C DO 1000 IX = 0,MCPAX C X = XL + (IX*SIDEX)/MCPAX C C*********************************************************************** C*********************************************************************** C DER = 1.0 Z = DCMPLX(X,Y) Z = 1/(A*Z*Z + B*Z + 1) Z = 1/(A*Z*Z + B*Z + 1) Z = 1/(A*Z*Z + B*Z + 1) Z = 1/(A*Z*Z + B*Z + 1) C DO 400 I = 5,NITER C AZ = A*Z Z = 1/(AZ*Z + B*Z + 1) C IF (DREAL(Z)*DREAL(Z) + IMAG(Z)*IMAG(Z) .GT. ESC ) GOTO 200 C D = (2*AZ + B)*Z*Z DER = DER*(DREAL(D)*DREAL(D) + IMAG(D)*IMAG(D)) IF (DER .LT. EPS) GOTO 300 C 400 CONTINUE C COL(IX,IY) = 7 GOTO 1000 C 200 IF (IMAG(ALPHA*Z) .LE. 0) THEN COL(IX,IY) = PENP(MOD(I,4)) + 13*I GOTO 1000 ELSE COL(IX,IY) = PENN(MOD(I,4)) + 13*I GOTO 1000 ENDIF C 300 COL(IX,IY) = 13*I GOTO 1000 C C*********************************************************************** C*********************************************************************** C 1000 CONTINUE 2000 CONTINUE C RETURN END