PROGRAM PARGEN C C....................................................................... C AN INTERACTIVE PREPROCESSOR TO HELP THE C O N F P A C K USER C GENERATE THE FORTRAN CODE DEFINING THE BOUNDARY PARAMETRISATION C AND ITS DERIVATIVE. C C THE FOLLOWING CONVENTIONS ARE ASSUMED: C C ** IF A QUESTION REQUIRES A YES OR NO ANSWER, THE DETECTION OF 'Y' OR C 'y' IN THE FIRST 6 INPUT CHARACTERS IS TAKEN AS YES, ANYTHING ELSE C AS NO. C C ** WHEN ASKED FOR COORDINATES, THIS ALWAYS MEANS CARTESIAN COORDIN- C ATES AND THESE SHOULD BE SUPPLIED AS TWO REAL NUMBERS, AS EITHER C C X,Y OR X Y C C WITHOUT PARENTHESES. C C ** FOUR TYPES OF ARCS ARE CURRENTLY TREATED, WITH NUMERICAL CODES TO C DENOTE THE TYPE AS FOLLOWS: C 1:= LINE SEGMENT. C 2:= CIRCULAR ARC SEGMENT. C CONVENTIONS: C 1 - THE ANGLE SUBTENDED AT THE CENTRE IS POSITIVE FOR C ANTICLOCKWISE TRAVERSAL OF THE ARC AND NEGATIVE FOR C CLOCKWISE TRAVERSAL. C 3:= THE USER IS ASKED TO SUPPLY THE FORTRAN 77 ARITHMETIC C EXPRESSIONS WHICH DEFINE THE CARTESIAN PARAMETRIC FUNCTION C AND THE DERIVATIVE OF THIS FUNCTION. C CONVENTIONS: C 1 - THE PARAMETER MUST BE DENOTED BY T. C 2 - THE REAL CONSTANT PI=3.14159.. AND THE COMPLEX CONSTANT C UI=(0.0,1.0) MAY BE USED IN THE ARITHMETIC EXPRESSIONS. C 4:= THE USER IS ASKED TO SUPPLY THE FORTRAN 77 ARITHMETIC C EXPRESSIONS WHICH DEFINE THE POLAR COORDINATE AS A FUNCTION C OF POLAR ANGLE AND THE DERIVATIVE OF THIS FUNCTION. C CONVENTIONS: C 1 - THE POLAR ANGLE MUST BE DENOTED BY T. C 2 - THE REAL CONSTANT PI=3.14159.. MAY BE USED IN THE ARITH- C METIC EXPRESSIONS. C 3 - PARGEN ASSIGNS THE EXPRESSION FOR THE RADIUS TO THE C COMPLEX VARIABLE ZRAD; IF REQUIRED THE USER MAY THERE- C FORE USE THE VARIABLE ZRAD IN THE EXPRESSION FOR THE C DERIVATIVE OF THE RADIUS WRT POLAR ANGLE C IN ADDITION, FOR TYPES 3 AND 4, THE FOLLOWING CONVENTIONS HOLD: C 1 - ONLY USE UP TO 66 CHARACTERS PER LINE. C 2 - IF THE EXPRESSION OCCUPIES MORE THAN ONE LINE THEN THERE C IS NO NEED TO SUPPLY ANY CONTINUATION CHARACTER. C 3 - ONLY USE THOSE FORTRAN 77 INTRINSIC MATHS FUNCTIONS C WHICH ACCEPT COMPLEX ARGUMENTS AND ARE ANALYTIC; I.E., C IN STANDARD FORTRAN, C SQRT, EXP, LOG, SIN, COS C 4 - THE WHOLE EXPRESSION SHOULD BE TERMINATED WITH A C REPEATED DIVISION SIGN, I.E. //. C C ** THE CODE ISN'T VERY ROBUST IN THAT THERE IS LITTLE PROVISION FOR C INTERACTIVE CORRECTION OF ERRORS. HOWEVER, ALL THE USER'S INPUT C IS AUTOMATICALLY OUTPUT TO A FILE NAMED pgenin. IF THE USER C REALISES THAT AN ITEM HAS BEEN INPUT INCORRECTLY, THE BEST POLICY C IS TO CARRY ON TO THE END OF THE INPUT PHASE AND THEN TERMINATE C THE EXECUTION; THE FILE pgenin CAN BE EDITED, RENAMED AND C SUBMITTED AS STANDARD INPUT FOR A SECOND RUN OF PARGEN. C (THE SUGGESTION TO RENAME IS TO AVOID ANY POSSIBLE DIFFICULTY C ARISING FROM READING THE FILE AS STANDARD INPUT WHILST ALSO C WRITING OUTPUT TO THE SAME FILE.) C IF THE USER REALISES ONLY AT A LATER STAGE (E.G. IN PLOTTING THE C BOUNDARY) THAT AN ITEM HAS BEEN INPUT INCORRECTLY THEN pgenin C MAY STILL BE AVAILABLE FOR RE-USE AS ABOVE. C C SUBROUTINES OR FUNCTIONS NEEDED C - THE CONFPACK LIBRARY. C - THE REAL FUNCTION R1MACH. C C....................................................................... C AUTHOR: DAVID HOUGH, COVENTRY POLYTECHNIC, UK C LAST UPDATE: 15 FEB 1991 C....................................................................... C C LOCAL VARIABLES C INTEGER CHIN,CHNL,GMCO,IA,I,IER,J,L,MNARC,NARCS,ORDRG,ORDSG,SW, +TXCO,TYPE REAL ALPHA,EPS,PI,R1MACH,X,Y COMPLEX CENSY,RTUNI,U2 LOGICAL CHRIN,REFLN,SYMTY,CHCK CHARACTER TXT*72,TABC*6,FORTFL*72,CH*2,SIG(10)*2,WID(10)*2,REDD*6, +FMT1*8,FMT2*9 C PARAMETER (MNARC=100,TABC=' +',CHNL=20,CHIN=21) INTEGER ARCTY(MNARC),PGM(MNARC),PTX(MNARC*2),NTX(MNARC*2) REAL RGM(3*MNARC) COMPLEX STAPT(MNARC) LOGICAL NUMDER(MNARC) CHARACTER DEFN(MNARC*2)*72 C EXTERNAL CHRIN,HEADER,R1MACH,SYINF1,WRFUN1,WRFUN2,WRHEAD,WRSYM1, +WRSYM2,WRSYM3,WRTAIL C DATA +SIG/'7','8','9','10','11','12','13','14','15','16'/ +WID/'15','16','17','18','19','20','21','22','23','24'/ C CALL WRHEAD(6,0) C PI=4E+0*ATAN(1E+0) OPEN(CHIN,FILE='pgenin') C C**** DETERMINE NUMBER OF SIGNIFICANT FIGURES REQUIRED TO MATCH MACHINE C**** PRECISION AND SET UP POINTER SW TO SIG AND WID C EPS=R1MACH(4) SW=INT(-LOG10(EPS))+2 IF (SW.LE.7) THEN SW=1 ELSE IF (SW.GE.16) THEN SW=10 ELSE SW=SW-6 ENDIF C C**** SET UP THE EDIT DESCRIPTOR AND FORMAT SPECIFICATION FOR FLOATING C**** POINT OUTPUT C REDD='E'//WID(SW)//'.'//SIG(SW) FMT1='('//REDD//')' FMT2='(2'//REDD//')' C WRITE(*,*) 'FILENAME TO RECEIVE OUTPUT FORTRAN CODE?' READ(*,'(A)') FORTFL WRITE(CHIN,'(A)') FORTFL C WRITE(*,*) 'DOES THE DOMAIN HAVE ANY SYMMETRY?' SYMTY=CHRIN('Y','y') IF (SYMTY) THEN WRITE(CHIN,*) 'Y',' ..SYMMETRY' ELSE WRITE(CHIN,*) 'N',' ..SYMMETRY' ENDIF IF (SYMTY) THEN WRITE(*,*) 'ARE THERE ANY REFLECTIONAL SYMMETRIES?' REFLN=CHRIN('Y','y') IF (REFLN) THEN WRITE(CHIN,*) 'Y',' ..REFLECTIONAL SYMMETRY' ELSE WRITE(CHIN,*) 'N',' ..REFLECTIONAL SYMMETRY' ENDIF WRITE(*,*) 'WHAT ARE THE COORDINATES OF THE CENTRE OF SYMMETRY?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y CENSY=CMPLX(X,Y) WRITE(*,*) 'HOW MANY ARCS ARE THERE ON THE FUNDAMENTAL BOUNDARY +SECTION?' READ(*,*) NARCS WRITE(CHIN,*) NARCS,' ..NUMBER OF ARCS ON FBS' ELSE WRITE(*,*) 'HOW MANY ARCS ARE THERE ON THE BOUNDARY?' READ(*,*) NARCS WRITE(CHIN,*) NARCS,' ..NUMBER OF ARCS ON BOUNDARY' ENDIF C IF (NARCS.GT.MNARC-1) THEN IER=58 GOTO 999 ENDIF C GMCO=0 TXCO=0 C DO 100 IA=1,NARCS NUMDER(IA)=.FALSE. 5 CONTINUE WRITE(*,'(//A,I2,A)') 'TYPE OF ARC ',IA,'?' READ(*,*) TYPE WRITE(CHIN,*) TYPE,' ..TYPE FOR ARC',IA IF (TYPE.EQ.1) THEN ARCTY(IA)=TYPE WRITE(*,*) 'COORDINATES OF INITIAL POINT ON LINE?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y STAPT(IA)=CMPLX(X,Y) ELSE IF (TYPE.EQ.2) THEN ARCTY(IA)=TYPE WRITE(*,*) 'COORDINATES OF INITIAL POINT ON CIRCLE?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y STAPT(IA)=CMPLX(X,Y) WRITE(*,*) 'COORDINATES OF CENTRE OF CIRCLE?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y WRITE(*,*)'SIGNED ANGLE SUBTENDED AT CENTRE (IN UNITS OF PI)?' READ(*,*) ALPHA WRITE(CHIN,FMT1) ALPHA GMCO=GMCO+1 PGM(IA)=GMCO RGM(GMCO)=X GMCO=GMCO+1 RGM(GMCO)=Y GMCO=GMCO+1 RGM(GMCO)=ALPHA*PI ELSE IF (TYPE.EQ.3 .OR. TYPE.EQ.4) THEN ARCTY(IA)=TYPE WRITE(*,*) 'COORDINATES OF INITIAL POINT ON CURVE?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y STAPT(IA)=CMPLX(X,Y) IF (TYPE.EQ.3) THEN WRITE(*,*) 'INITIAL AND FINAL PARAMETER VALUES?' ELSE WRITE(*,*)'INITIAL AND FINAL POLAR ANGLES (IN UNITS OF PI)?' ENDIF READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y GMCO=GMCO+1 PGM(IA)=GMCO IF (TYPE.EQ.4) THEN RGM(GMCO)=X*PI GMCO=GMCO+1 RGM(GMCO)=Y*PI ELSE RGM(GMCO)=X GMCO=GMCO+1 RGM(GMCO)=Y ENDIF DO 50 J=1,2 IF (J.EQ.1 .AND. TYPE.EQ.3) THEN WRITE(*,*) 'FORTRAN EXPRESSION FOR PARFUN?' ELSE IF (J.EQ.2 .AND. TYPE.EQ.3) THEN WRITE(*,*) 'FORTRAN EXPRESSION FOR DPARFN?' ELSE IF (J.EQ.1 .AND. TYPE.EQ.4) THEN WRITE(*,*) 'FORTRAN EXPRESSION FOR RADIUS?' ELSE WRITE(*,*) 'FORTRAN EXPRESSION FOR RADIUS DERIVATIVE?' ENDIF C TXCO=TXCO+1 PTX(IA+(J-1)*MNARC)=TXCO I=1 C 10 CONTINUE READ(*,'(A72)') TXT WRITE(CHIN,'(A72)') TXT L=INDEX(TXT,'//') IF (L.EQ.0) THEN IF (TXT(67:72) .NE. ' ') THEN WRITE(*,*) 'THIS LINE IS MORE THAN 66CH LONG.' WRITE(*,*) 'PLEASE SPLIT AND ENTER AS SEPERATE LINES.' GOTO 10 ENDIF DEFN(TXCO)=TABC//TXT I=I+1 TXCO=TXCO+1 GOTO 10 ELSE IF (L.GT.67) THEN WRITE(*,*) 'THIS LINE IS MORE THAN 66CH LONG.' WRITE(*,*) 'PLEASE SPLIT AND ENTER AS SEPERATE LINES.' GOTO 10 ENDIF NTX(IA+(J-1)*MNARC)=I IF (L.EQ.1) THEN DEFN(TXCO)=TABC NUMDER(IA)=.TRUE. ELSE DEFN(TXCO)=TABC//TXT(1:L-1) ENDIF ENDIF IF (J.EQ.1 .AND. TYPE.EQ.4) THEN WRITE(*,*) '(... = ZRAD)' ENDIF 50 CONTINUE ELSE WRITE(*,*) 'TYPE MUST BE EITHER 1,2,3 OR 4' GOTO 5 ENDIF 100 CONTINUE C IF (SYMTY) THEN WRITE(*,*) 'COORDINATES OF FINAL POINT ON THIS ARC?' READ(*,*) X,Y WRITE(CHIN,FMT2) X,Y STAPT(NARCS+1)=CMPLX(X,Y) ELSE STAPT(NARCS+1)=STAPT(1) ENDIF C C**** CHECK WITH THE USER THAT THE INPUT DATA IS OK C IER=0 WRITE(*,*) WRITE(*,*) 'END OF INPUT PHASE; CONTINUE WITH PROCESSING?' CHCK=CHRIN('Y','y') IF (.NOT.CHCK) THEN WRITE(CHIN,*) 'N',' ..CONTINUE PROCESSING' GOTO 999 ELSE WRITE(CHIN,*) 'Y',' ..CONTINUE PROCESSING' ENDIF CLOSE(CHIN) C C**** WRITE THE SOURCE CODE FOR PARFUN C OPEN(CHNL,FILE=FORTFL) CALL HEADER('PARFUN',REDD,CHNL) IF (SYMTY) THEN CALL SYINF1(ORDRG,ORDSG,RTUNI,U2,REFLN,CENSY,STAPT(1), + STAPT(NARCS+1),IER) IF (IER.GT.0) GOTO 999 WRITE(*,'(/A,I3)') 'N O T E : THE ORDER OF THE SYMMETRY GROUP IS +',ORDSG IF (REFLN) THEN WRITE(*,*) ' ISYGP = ',-ORDSG ELSE WRITE(*,*) ' ISYGP = ',ORDSG ENDIF CALL WRSYM1(NARCS,ORDRG,ORDSG,RTUNI,U2,CENSY,REFLN,.TRUE.,REDD, + CHNL) IF (REFLN) THEN CH='TS' ELSE CH='TT' ENDIF CALL WRFUN1(NARCS,STAPT,ARCTY,PGM,RGM,PTX,NTX,DEFN,CHNL, + 'IB',CH,'ZETA ',REDD) CALL WRSYM2(NARCS,ORDRG,CENSY,REFLN,CHNL) ELSE CALL WRFUN1(NARCS,STAPT,ARCTY,PGM,RGM,PTX,NTX,DEFN,CHNL, + 'IA','TT','PARFUN',REDD) ENDIF C WRITE(CHNL,'(A1)') 'C' WRITE(CHNL,'(A9)') ' END' C C**** WRITE THE SOURCE CODE FOR DPARFN C WRITE(CHNL,'(A40)') 'C...........................................' CALL HEADER('DPARFN',REDD,CHNL) IF (SYMTY) THEN CALL WRSYM1(NARCS,ORDRG,ORDSG,RTUNI,U2,CENSY,REFLN,.FALSE.,REDD, + CHNL) IF (REFLN) THEN CH='TS' ELSE CH='TT' ENDIF CALL WRFUN2(NARCS,MNARC,STAPT,ARCTY,PGM,RGM,PTX,NTX,DEFN, + CHNL,'IB',CH,'ZETA ',NUMDER,REDD) CALL WRSYM3(NARCS,ORDRG,REFLN,CHNL) ELSE CALL WRFUN2(NARCS,MNARC,STAPT,ARCTY,PGM,RGM,PTX,NTX,DEFN, + CHNL,'IA','TT','DPARFN',NUMDER,REDD) ENDIF C WRITE(CHNL,'(A1)') 'C' WRITE(CHNL,'(A9)') ' END' CLOSE(CHNL) C 999 CONTINUE CALL WRTAIL(6,0,IER) C END C COMPLEX FUNCTION PARFUN(I,T) INTEGER I COMPLEX T C C DUMMY FUNCTION TO AID LINK-LOADING OF PARGEN C PARFUN=(1.0,0.0) END C COMPLEX FUNCTION DPARFN(I,T) INTEGER I COMPLEX T C C DUMMY FUNCTION TO AID LINK-LOADING OF PARGEN C DPARFN=(1.0,0.0) END