PROGRAM DRIVE0 INTEGER CHNL,IER,NARCS REAL MXMIS,MXDIF,PSD,MINPD,MAXPD CHARACTER*4 JBNM PARAMETER(CHNL=20) EXTERNAL TSTPLT C DATA PSD,MINPD,MAXPD/3*0.0/ C WRITE(*,*) 'JOBNAME (<=4 CHARACTERS) ?' READ(*,'(A4)') JBNM WRITE(*,*) 'HOW MANY ARCS ON THE WHOLE BOUNDARY?' READ(*,*) NARCS CALL TSTPLT(JBNM,MXMIS,MXDIF,NARCS,PSD,MINPD,MAXPD,CHNL,IER) C END PROGRAM DRIVE1 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SYMM EQUATION SOLVING C SUBROUTINE JAPHYC FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED FOR MAIN SUBROUTINE C INTEGER IER,ISYGP,NARCS,NQPTS,RFARC,TSTNG,OULVL,MNEQN,MNJXS, +MQIN1,MNQUA,MNSUA,CHNL REAL MAXER,RFARG COMPLEX CENTR LOGICAL INCST,INTER CHARACTER JBNM*4,HEAD*72 C C MNEQN= MAXIMUM NUMBER OF LINEAR EQUATIONS ALLOWED IN THE C COLLOCATION SOLUTION OF SYMM'S EQUATION C C MNJXS= (MAXIMUM NUMBER OF CORNERS ALLOWED) + 1 C C MQIN1= (MAXIMUM NUMBER OF PANELS ALLOWED IN A SINGLE C COMPOSITE GAUSSIAN RULE) + 1 C C MNQUA= MAXIMUM TOTAL NUMBER OF QUADRATURE POINTS ALLOWED OVER C ALL COMPOSITE GAUSSIAN RULES AT THE PROCESSING STAGE OF C SOLVING SYMM'S EQUATION C C MNSUA= MAXIMUM NUMBER OF SUBARCS ALLOWED ON THE PHYSICAL C BOUNDARY C C THE ABOVE BOUNDS ARE RELATED TO THE NUMBER OF QUADRATURE POINTS C NQPTS VIA C MNEQN <= MNSUA*NQPTS + 1 C MNQUA <= (MQIN1-1)*MNJXS*NQPTS C C BUT IN PRACTICE MNEQN AND MNQUA MAY BE SIGNIFICANTLY C LESS THAN THE VALUES ON THE RIGHT OF THESE INEQUALITIES. C C SUGGESTED VALUES TO COVER A WIDE RANGE OF PROBLEMS ARE SET IN C THE FOLLOWING PARAMETER STATEMENT. C PARAMETER (CHNL=20,NQPTS=8, +MNSUA=150,MNEQN=500,MNJXS=50,MQIN1=11,MNQUA=2000) C INTEGER +IBNDS(4), +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IWORK(8*MNSUA+2*MNJXS+MNEQN) C REAL +RGEOM(3*MNSUA+2), +MATRX(MNEQN,MNEQN,2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RWORK(3*NQPTS*NQPTS+4*NQPTS+5*MNJXS*NQPTS+2*MNSUA+2*MNQUA+MQIN1+ + 5*MNJXS+2*MNEQN) C COMPLEX +ZWORK(2*MNJXS+MNEQN) C LOGICAL LWORK(3*MNSUA+MNJXS) C EXTERNAL JAPHYC C C SET UP THE ARRAY OF BOUNDS IBNDS FOR JAPHYC C IBNDS(1)=MNSUA IBNDS(2)=MNJXS IBNDS(3)=MQIN1 IBNDS(4)=MNQUA C C READ IN THE DATA FOR THIS PROBLEM FROM THE FILE jobin. C OPEN(CHNL,FILE='jobin') READ(CHNL,'(A4)') JBNM READ(CHNL,'(A72)') HEAD READ(CHNL,*) INTER READ(CHNL,*) NARCS READ(CHNL,*) ISYGP READ(CHNL,*) RFARC READ(CHNL,*) RFARG READ(CHNL,*) INCST READ(CHNL,*) TSTNG READ(CHNL,*) CENTR READ(CHNL,*) MAXER READ(CHNL,*) OULVL CLOSE(CHNL) C C SOLVE SYMM'S INTEGRAL EQUATION, TO ESTIMATE THE JACOBI C COEFFICIENTS FOR THE DENSITY ASSOCIATED WITH THE MAP : PHYSICAL C --> CANONICAL, WITH AUTOMATIC CREATION OF OUTPUT FILES C jbnm, pl, gm, ph. C CALL JAPHYC(JBNM,HEAD,MAXER,INTER,NARCS,ISYGP,NQPTS,INCST,RFARC, + RFARG,CENTR,TSTNG,OULVL,IBNDS,MNEQN,MATRX,IWORK,RWORK, + ZWORK,LWORK,CHNL,IGEOM,RGEOM,ISNPH,RSNPH,IER) END PROGRAM DRIVE2 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINES GQPHYC FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED C INTEGER IER,NQPTS,MNEQN,MNJXS,MQIN1,MQUPH,MNSUA,CHNL,CHN1 COMPLEX CENTR LOGICAL INTER C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNEQN - DRIVE1 C MNJXS - DRIVE1 C MNSUA - DRIVE1 C MQIN1 - DRIVE1 C NQPTS - JAPHYC C C MQUPH= MAXIMUM NUMBER OF QUADRATURE POINTS ALLOWED IN THE GLOBAL C COMPOSITE GAUSSIAN RULE FOR EVALUATION OF THE MAP:PHYSICAL C -->CANONICAL. C MQUPH SHOULD SATISFY C C MQUPH <= (MQIN1-1)*NQPTS*MNSUA , C C BUT IN PRACTICE MQUPH MAY BE SIGNIFICANTLY LESS THAN THE C VALUE ON THE RIGHT OF THIS INEQUALITY. C PARAMETER (CHNL=20,CHN1=21,NQPTS=8, +MNSUA=150,MNEQN=500,MNJXS=50,MQIN1=11,MQUPH=3000) C INTEGER +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IQUPH(2*MNSUA+4) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RWORK(MQIN1), +RQUPH(3*MQUPH+1) C COMPLEX +ZQUPH(MQUPH+1) C EXTERNAL GQPHYC,INPTGM,INPTPH C C INPUT THAT DATA NEEDED BY GQPHYC AND PREVIOUSLY SET UP BY JAPHYC. C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTPH(ISNPH,RSNPH,CHNL) C C SET UP THE GLOBAL COMPOSITE GAUSSIAN QUADRATURE RULE FOR C COMPUTING THE MAP : PHYSICAL --> CANONICAL WITH AUTOMATIC C CREATION OF THE OUTPUT FILE pq C CALL GQPHYC(MQIN1,MQUPH,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH,RWORK, + CHNL,IQUPH,RQUPH,ZQUPH,IER) C END PROGRAM DRIVE3 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINE DMPHYC FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED C INTEGER IER,NQPTS,MNEQN,MNJXS,MQUPH,MNSUA,CHNL,CHN1 REAL X,Y COMPLEX CENTR,CA,PH LOGICAL INTER CHARACTER ANS*1 C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNEQN - DRIVE1 C MNJXS - DRIVE1 C MNSUA - DRIVE1 C MQUPH - DRIVE2 C NQPTS - JAPHYC C PARAMETER (CHNL=20,CHN1=21,NQPTS=8, +MNSUA=150,MNEQN=500,MNJXS=50,MQUPH=3000) C INTEGER +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IQUPH(2*MNSUA+4) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RQUPH(3*MQUPH+1) C COMPLEX +ZQUPH(MQUPH+1) C EXTERNAL DMPHYC,INPTGM,INPTPH,INPTPQ C C INPUT THAT DATA NEEDED BY DMPHYC AND PREVIOUSLY SET UP BY JAPHYC C AND GQPHYC. C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTPH(ISNPH,RSNPH,CHNL) CALL INPTPQ(IQUPH,RQUPH,ZQUPH,CHNL) C C START MAPPING C 10 CONTINUE WRITE(*,*) 'X,Y COORDS. OF PHYSICAL POINT?' READ(*,*) X,Y PH=CMPLX(X,Y) CALL DMPHYC(1,PH,CA,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH, + IQUPH,RQUPH,ZQUPH,.TRUE.,IER) IF (IER.GT.0) STOP WRITE(*,*) 'CANONICAL POINT:',CA WRITE(*,'(/,A)') 'ANOTHER POINT (Y OR N)?' READ(*,'(A1)') ANS IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10 C END PROGRAM DRIVE4 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINE CNDPLT FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED C INTEGER IER,NQPTS,MNEQN,MNJXS,MNSUA,CHNL,CHN1 REAL RESMN,UPHYC,UCANP,CRRES COMPLEX CENTR LOGICAL MAP11,INTER C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNEQN - DRIVE1 C MNJXS - DRIVE1 C MNSUA - DRIVE1 C NQPTS - JAPHYC C PARAMETER (CHNL=20,CHN1=21,NQPTS=8, +MNSUA=150,MNEQN=500,MNJXS=50,CRRES=1E+1) C INTEGER +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS) C EXTERNAL CNDPLT,INPTGM,INPTPH C C INPUT THAT DATA NEEDED BY CNDPLT AND PREVIOUSLY SET UP BY JAPHYC. C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTPH(ISNPH,RSNPH,CHNL) C C EXAMINE THE CONDITION OF THE MAPPING PROBLEMS AND OUTPUT DATA C FOR PLOTTING GRAPHS OF BOUNDARY CORRESPONDENCE FUNCTION AND ITS C DERIVATIVE TO FILES p0 AND p1 RESPECTIVELY. THE C INPUT ARGUMENTS '# -m 2' AND '#' ARE INSTALLATION DEPENDENT AND C RELATE TO LOCAL GRAPH PLOTTING REQUIREMENTS. C CALL CNDPLT(MAP11,RESMN,UPHYC,UCANP,CRRES,IGEOM,RGEOM,ISNPH, + RSNPH,CHNL,CHN1,'# -m 2','#',IER) C END PROGRAM DRIVE5 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINE JACANP FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED FOR MAIN SUBROUTINES C INTEGER IER,NQPTS,MNCOF,MNEQN,MNJXS,MQUPH,MNSUA, +MNSUC,CHNL COMPLEX CENTR LOGICAL INTER C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNEQN - DRIVE1 C MNJXS - DRIVE1 C MNSUA - DRIVE1 C MQUPH - DRIVE2 C NQPTS - JAPHYC C C MNCOF= MAXIMUM TOTAL NUMER OF JACOBI COEFFICIENTS ALLOWED IN C ESTIMATING THE DENSITY FUNCTION FOR THE INVERSE MAP: C CANONICAL --> PHYSICAL C C MNSUC= MAXIMUM NUMBER OF SUBARCS ALLOWED ON THE UNIT DISC C C THE ABOVE BOUNDS SHOULD SATISFY C C MNCOF <= MNSUC*NQPTS C MNSUA <= MNSUC C C BUT IN PRACTICE MNCOF MAY BE SIGNIFICANTLY C LESS THAN THE VALUE ON THE RIGHT OF THE INEQUALITY. C C SUGGESTED VALUES TO COVER A WIDE RANGE OF PROBLEMS ARE SET IN C THE FOLLOWING PARAMETER STATEMENT. C PARAMETER (CHNL=20,NQPTS=8,MNCOF=800,MNSUC=200, +MNSUA=150,MNEQN=500,MNJXS=50,MQUPH=3000) C INTEGER +IBNDS(2), +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IQUPH(2*MNSUA+4), +ISNCA(4*MNSUC+6) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RWORK(MNJXS*NQPTS), +RQUPH(3*MQUPH+1), +RSNCA(2*MNSUC+4*MNJXS+6*MNJXS*NQPTS+2) C COMPLEX +ZQUPH(MQUPH+1), +ZSNCA(2*MNCOF+1) C EXTERNAL INPTGM,INPTPH,INPTPQ,JACANP C C SET UP THE ARRAY OF BOUNDS IBNDS C IBNDS(1)=MNSUC IBNDS(2)=MNCOF C C INPUT THAT DATA NEEDED BY JACANP AND PREVIOUSLY SET UP BY JAPHYC C AND GQPHYC. C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTPH(ISNPH,RSNPH,CHNL) CALL INPTPQ(IQUPH,RQUPH,ZQUPH,CHNL) C C ESTIMATE THE JACOBI COEFFICIENTS FOR THE DENSITY ASSOCIATED WITH C THE MAP : CANONICAL --> PHYSICAL, WITH AUTOMATIC CREATION OF C THE OUTPUT FILES cl, ca. C CALL JACANP(IBNDS,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH,IQUPH, + RQUPH,ZQUPH,RWORK,CHNL,ISNCA,RSNCA,ZSNCA,IER) C END PROGRAM DRIVE6 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINE GQCANP FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED C INTEGER IER,NQPTS,MNCOF,MNJXS,MQIN1,MQUCA,MNSUC,CHNL C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNCOF - DRIVE5 C MNJXS - DRIVE1 C MNSUC - DRIVE5 C NQPTS - JAPHYC C C ARRAY BOUND PARAMETERS MNJXS, MNCOF AND MNSUC AS IN DRIVE5. C C MQIN1= (MAXIMUM NUMBER OF PANELS ALLOWED IN A SINGLE C COMPOSITE GAUSSIAN RULE) + 1 C C MQUCA= MAXIMUM NUMBER OF QUADRATURE POINTS ALLOWED IN THE GLOBAL C COMPOSITE GAUSSIAN RULE FOR EVALUATION OF THE MAP:CANONICAL C -->PHYSICAL C C MQUCA SHOULD SATISFY C C MQUCA <= (MQIN1-1)*NQPTS*MNSUC C C BUT IN PRACTICE MAY BE SIGNIFICANTLY LESS THAN THE VALUE C ON THE RIGHT OF THIS INEQUALITY. C PARAMETER (CHNL=20,NQPTS=8, +MNJXS=50,MQIN1=11,MNCOF=800,MNSUC=200,MQUCA=3000) C INTEGER +ISNCA(4*MNSUC+6), +IQUCA(2*MNSUC+4) C REAL +RWORK(MQIN1), +RSNCA(2*MNSUC+4*MNJXS+6*MNJXS*NQPTS+2) C COMPLEX +ZSNCA(2*MNCOF+1), +ZQUCA(2*MQUCA+1) C EXTERNAL GQCANP,INPTCA C C INPUT THAT DATA NEEDED BY CGCANP AND PREVIOUSLY SET UP BY JACANP. C CALL INPTCA(ISNCA,RSNCA,ZSNCA,CHNL) C C SET UP GLOBAL COMPOSITE GAUSSIAN QUADRATURE RULE FOR COMPUTING C THE MAP: CANONICAL --> PYSICAL, WITH AUTOMATIC CREATION OF C QUADRATURE DATE FILE cq. C CALL GQCANP(MQIN1,MQUCA,ISNCA,RSNCA,ZSNCA,RWORK,CHNL,IQUCA,ZQUCA, + IER) C END PROGRAM DRIVE7 C C....................................................................... C EXAMPLE PROGRAM TO SHOW THE USE OF THE SUBROUTINES DMCANP AND C DMPHYC FROM THE C C C O N F P A C K L I B R A R Y . C....................................................................... C C SCALAR VARIABLES REQUIRED C INTEGER IER,NQPTS,MNCOF,MNEQN,MNJXS,MQUCA,MQUPH,MNSUA,MNSUC,CHNL REAL X,Y COMPLEX CENTR,CA,CA1,PH,PH1 LOGICAL INTER CHARACTER*1 ANS C C THE FOLLOWING ARRAY BOUND PARAMETERS ARE EXPLAINED ELSEWHERE: C MNCOF - DRIVE5 C MNEQN - DRIVE1 C MNJXS - DRIVE1 C MNSUA - DRIVE1 C MNSUC - DRIVE5 C MQUCA - DRIVE6 C MQUPH - DRIVE2 C NQPTS - JAPHYC C PARAMETER (CHNL=20,NQPTS=8, +MNCOF=800,MNEQN=500,MNJXS=50,MNSUA=150,MNSUC=200,MQUCA=3000, +MQUPH=3000) C INTEGER +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IQUPH(2*MNSUA+4), +ISNCA(4*MNSUC+6), +IQUCA(2*MNSUC+4) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RQUPH(3*MQUPH+1), +RSNCA(2*MNSUC+4*MNJXS+6*MNJXS*NQPTS+2) C COMPLEX +ZQUPH(MQUPH+1), +ZSNCA(2*MNCOF+1), +ZQUCA(2*MQUCA+1) C EXTERNAL DMCANP,DMPHYC,INPTCA,INPTCQ,INPTGM,INPTPH,INPTPQ C C INPUT ALL SOLUTION AND QUADRATURE DATA PREVIOUSLY COMPUTED BY C JAPHYC, GQPHYC, JACANP AND GQCANP AND NEEDED BY EITHER DMPHYC OR C DMCANP. C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTPH(ISNPH,RSNPH,CHNL) CALL INPTPQ(IQUPH,RQUPH,ZQUPH,CHNL) CALL INPTCA(ISNCA,RSNCA,ZSNCA,CHNL) CALL INPTCQ(IQUCA,ZQUCA,CHNL) C C START MAPPING C 10 CONTINUE WRITE(*,*) 'DOMAIN OF MAP (P FOR PHYSICAL, C FOR CANONICAL) ?' READ(*,'(A1)') ANS IF (ANS.EQ.'P' .OR. ANS.EQ.'p') THEN WRITE(*,*) 'X,Y COORDS. OF PHYSICAL POINT?' READ(*,*) X,Y PH=CMPLX(X,Y) CALL DMPHYC(1,PH,CA,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH, + IQUPH,RQUPH,ZQUPH,.TRUE.,IER) IF (IER.GT.0) STOP WRITE(*,*) ' CORRESPONDING CANONICAL POINT:',CA C C MAP CANONICAL POINT CA BACK TO PHYSICAL DOMAIN C CALL DMCANP(1,PH1,CA,INTER,CENTR,IGEOM,RGEOM,ISNCA,RSNCA, + ZSNCA,IQUCA,ZQUCA,.TRUE.,IER) IF (IER.GT.0) STOP WRITE(*,*) ' THIS MAPS BACK TO THE PHYSICAL POINT:',PH1 ELSE WRITE(*,*) 'X,Y COORDS. OF CANONICAL POINT?' READ(*,*) X,Y CA=CMPLX(X,Y) CALL DMCANP(1,PH,CA,INTER,CENTR,IGEOM,RGEOM,ISNCA,RSNCA, + ZSNCA,IQUCA,ZQUCA,.TRUE.,IER) WRITE(*,*) ' CORRESPONDING PHYSICAL POINT:',PH C C MAP PHYSICAL POINT PH BACK TO CANONICAL DOMAIN C CALL DMPHYC(1,PH,CA1,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH, + IQUPH,RQUPH,ZQUPH,.TRUE.,IER) IF (IER.GT.0) STOP WRITE(*,*) ' THIS MAPS BACK TO THE CANONICAL POINT:',CA1 ENDIF WRITE(*,'(/,A)') 'ANOTHER POINT (Y OR N)?' READ(*,'(A1)') ANS IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10 C END PROGRAM DRIVE8 C C EXAMPLE PROGRAM TO SHOW THE USE AND TESTING OF THE MAPPING C ROUTINES BMPHYC, BMCANP AND DMPHYC FROM THE C C C O N F P A C K L I B R A R Y . C C THE SOLUTION DATA FOR THE BOUNDARY CORRESPONDENCE FUNCTIONS C AND QUADRATURE DATA HAVE PREVIOUSLY BEEN STORED IN DATA FILES C THROUGH THE USE OF ROUTINES JAPHYC, JACANP, GQPHYC AND GQCANP. C C IN THIS PROGRAM, WE START WITH A NUMBER OF TEST POINTS ON THE C BOUNDARY OF THE PHYSICAL DOMAIN; THESE ARE UNIFORMLY SPACED C WITH RESPECT TO THE PARAMETER ON EACH ANALYTIC ARC, THEIR NUMBER C BEING CHOSEN AT RUN TIME BY THE USER. C C EACH PHYSICAL TEST POINT, PH, IS MAPPED ONTO A POINT, CA, C ON THE UNIT DISC BY THE BOUNDARY MAPPING ROUTINE BMPHYC; C THE DERIVATIVE OF THE MAP : PHYSICAL --> CANONICAL AT PH IS ALSO C ESTIMATED AS, DPH. C C THE POINT CA IS THEN MAPPED BACK ONTO THE POINT PH1 IN PHYSICAL C DOMAIN BY THE BOUNDARY MAPPING ROUTINE BMCANP, AND THE DERIVATIVE C OF THE MAP:CANONICAL --> PHYSICAL AT CA IS ESTIMATED AS DCA. C C THE POINT PH1, WHICH WILL NOT GENERALLY LIE EXACTLY ON THE C PHYSICAL BOUNDARY OR COINCIDE WITH PH, IS THEN MAPPED TO THE C POINT CA1 ON THE UNIT DISC BY THE DOMAIN MAPPING ROUTINE DMPHYC. C C WE COMPUTE THE MAXIMUM OF THE QUANTITIES C C ABS(PH-PH1), ABS(CA-CA1), ABS(DPH*DCA -1) C C OVER ALL THE TEST POINTS. THE CALCULATION OF DPH*DCA IS OMITTED C AT CORNER POINTS SINCE ONE OF THESE IS ALWAYS ZERO AND THE C OTHER IS ALWAYS INFINITE. C C SCALAR VARIABLES C INTEGER CHNL,I,IER,J,MNEQN,MNJXS,MQUCA,MQUPH,MNCOF,MNSUA, +MNSUC,NARCS,NQPTS,NT C REAL HT,MXDER,MXCER,MXPER,THETA,TT C COMPLEX CA,CA1,CENTR,DCA,DPH,PARAM,PARFUN,PH,PH1 C LOGICAL INTER,WANTD C PARAMETER (CHNL=20,NQPTS=8, +MNCOF=800,MNEQN=500,MNJXS=50,MNSUA=150,MNSUC=200,MQUCA=3000, +MQUPH=3000) C C ARRAY VARIABLES C INTEGER +IGEOM(MNSUA+4), +ISNPH(3*MNSUA+6), +IQUPH(2*MNSUA+4), +ISNCA(4*MNSUC+6) C REAL +RGEOM(3*MNSUA+2), +RSNPH(2*MNEQN+MNSUA+3*MNJXS+6*MNJXS*NQPTS), +RQUPH(3*MQUPH+1), +RSNCA(2*MNSUC+4*MNJXS+6*MNJXS*NQPTS+2) C COMPLEX +ZQUPH(MQUPH+1), +ZSNCA(2*MNCOF+1) C EXTERNAL BMCANP,BMPHYC,DMPHYC,INPTCA,INPTGM,INPTPH,INPTPQ,PARFUN C WRITE(*,*) 'NUMBER OF TEST POINTS PER (OPEN) ARC ?' READ(*,*) NT C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) NARCS=IGEOM(1) C CALL INPTPH(ISNPH,RSNPH,CHNL) CALL INPTPQ(IQUPH,RQUPH,ZQUPH,CHNL) CALL INPTCA(ISNCA,RSNCA,ZSNCA,CHNL) C MXCER=0E+0 MXPER=0E+0 MXDER=0E+0 HT=2E+0/(NT+1E+0) DO 20 I=1,NARCS DO 10 J=0,NT TT=-1E+0+J*HT PARAM=CMPLX(TT) PH=PARFUN(I,PARAM) IF (J.EQ.0 .OR. J.EQ.(NT+1)) THEN WANTD=.FALSE. ELSE WANTD=.TRUE. ENDIF C C MAP PH ONTO CA, USING PARAMETER TO DEFINE PH C CALL BMPHYC(I,PARAM,CA,DPH,WANTD,INTER,IGEOM,RGEOM, + ISNPH,RSNPH,IQUPH,RQUPH,ZQUPH,.TRUE.,IER) IF (IER .GT. 0) STOP C C MAP CA ONTO PH1 C THETA=ATAN2(AIMAG(CA),REAL(CA)) CALL BMCANP(THETA,PH1,DCA,WANTD,INTER,CENTR,IGEOM,RGEOM, + ISNCA,RSNCA,ZSNCA,.TRUE.,IER) IF (IER .GT. 0) STOP C C MAP PH1 ONTO CA1 C CALL DMPHYC(1,PH1,CA1,INTER,CENTR,IGEOM,RGEOM,ISNPH,RSNPH, + IQUPH,RQUPH,ZQUPH,.TRUE.,IER) IF (IER .GT. 0) STOP C C DETERMINE THE MAXIMUM ERRORS TO DATE C MXPER=MAX(MXPER,ABS(PH-PH1)) MXCER=MAX(MXCER,ABS(CA-CA1)) C IF (WANTD) THEN MXDER=MAX(MXDER,ABS(DPH*DCA-1E+0)) ENDIF C 10 CONTINUE 20 CONTINUE C WRITE(*,*) WRITE(*,30) ' MAX ERROR IN PHYSICAL DOMAIN:',MXPER WRITE(*,30) 'MAX ERROR IN CANONICAL DOMAIN:',MXCER WRITE(*,30) ' MAX DERIVATIVE DISCREPANCY:',MXDER 30 FORMAT(A,E9.2) C END PROGRAM DRIVE9 C C EXAMPLE PROGRAM TO USE THE LEVEL CURVE DATA GENERATION ROUTINE C LEVCUR FROM THE C C C O N F P A C K L I B R A R Y . C C SCALAR VARIABLES C INTEGER CHNL,MNCOF,MNJXS,MNSUA,MNSUC,MQUCA,NCONT,NQPTS,I,IER REAL RAD1,RAD2,PSD,MINPD,MAXPD COMPLEX CENTR LOGICAL INTER C PARAMETER(CHNL=20,NQPTS=8, +MNSUA=150,MNSUC=200,MNCOF=800,MNJXS=50,MQUCA=3000) C INTEGER +IGEOM(MNSUA+4), +ISNCA(4*MNSUC+6), +IQUCA(2*MNSUC+4) C REAL +RADII(20), +THETA(20), +RGEOM(3*MNSUA+2), +RSNCA(2*MNSUC+4*MNJXS+6*MNJXS*NQPTS+2) C COMPLEX +ZSNCA(2*MNCOF+1), +ZQUCA(2*MQUCA+1) C EXTERNAL INPTCA,INPTCQ,INPTGM,LEVCUR C CALL INPTGM(IGEOM,RGEOM,CENTR,INTER,CHNL) CALL INPTCA(ISNCA,RSNCA,ZSNCA,CHNL) CALL INPTCQ(IQUCA,ZQUCA,CHNL) C WRITE(*,*) 'NUMBER OF CONTOURS?' READ(*,*) NCONT IF (NCONT.GT.0) THEN WRITE(*,*) 'ENTER ',NCONT,' RADII:' READ(*,*) (RADII(I),I=1,NCONT) ENDIF WRITE(*,*) 'ENTER STARTING AND FINISHING RADII FOR RAYS:' READ(*,*) RAD1,RAD2 PSD=0E+0 C C GENERATE LEVEL CURVE PLOTTING DATA, WITH OUTPUT TO THE FILE C lc ( IS READ FROM FILE jbnm BY LEVCUR). CONSIDER ONLY C THOSE RAYS WHICH TERMINATE AT CORNER POINTS. C CALL LEVCUR(NCONT,RADII,0,THETA,RAD1,RAD2,PSD,MINPD,MAXPD, + INTER,CENTR,IGEOM,RGEOM,ISNCA,RSNCA,ZSNCA,IQUCA,ZQUCA, + '#',CHNL,IER) C END .