Initial commit from Polytechnique Montreal

1 files changed, 135 insertions, 0 deletions

diff --git a/Utilib/src/PSTEXT.f b/Utilib/src/PSTEXT.f
new file mode 100644
index 0000000..a780d98
--- /dev/null
+++ b/Utilib/src/PSTEXT.f
@@ -0,0 +1,135 @@
+*DECK PSTEXT
+      SUBROUTINE PSTEXT(ISPSP,NBCAR,TEXT,XYPOS,HEIGHT,JUST,ANGL)
+C
+C---------------------------  PSTEXT  ---------------------------------
+C
+C  1- PROGRAMME STATISTICS:
+C      NAME     : PSTEXT
+C      USE      : PRINT POSTSCRIPT TEXT
+C                 ADAPTED FROM PSPLOT ROUTINE KELSYMC
+C
+C  2- ROUTINE PARAMETERS:
+C    INPUT/OUTPUT
+C      ISPSP    : PSP FILE UNIT                          I
+C      NBCAR    : NUMBER OF CHARACTER TO PRINT           I
+C      TEXT     : TEXT TO PRINT                          C*(*)
+C      YXPOS    : POSITION OF TEXT                       R(2)
+C      HEIGHT   : TEXT HEIGHT                            R
+C      JUST     : JUSTIFICATION                          I
+C                 = 0 CENTER
+C                 = 1 LEFT
+C                 = 2 RIGHT
+C      ANGL     : TEXT ROTATION ANGLE                    R
+C    LOCAL
+C      IBSL     : ASCII REPRESENTATION OF BACKSLASH      I
+C
+C---------------------------   PSTEXT  --------------------------------
+C
+      IMPLICIT         NONE
+      INTEGER          ISPSP,NBCAR,JUST
+      CHARACTER        TEXT*(*)
+      REAL             XYPOS(2),HEIGHT,ANGL
+C----
+C  LOCAL VARIABLES
+C----
+      INTEGER          IBSL,MXCHAR
+      CHARACTER        NAMSBR*6
+      REAL             CONVER,SZRAT,PI
+      PARAMETER       (IBSL=92,MXCHAR=80,NAMSBR='PSTEXT',
+     >                 CONVER=72.0,SZRAT=0.6,PI=3.1415926535897932)
+      INTEGER          IHT,ICHAR,NRCHAR,LJUST
+      CHARACTER        CBSL*1,CMDSTR*132,LINE*(MXCHAR),
+     >                 CADD*16,CBDD*16
+      REAL             STRLEN,ANGD,XYROT(2)
+C----
+C  STROKE PREVIOUS PATHS BEFORE THIS WRITE
+C----
+      CBSL=CHAR(IBSL)
+      CMDSTR='S'
+      CALL PSCPUT(ISPSP,CMDSTR)
+C----
+C  SET CURRENT CHARACTER SIZE
+C----
+      IHT=INT(HEIGHT*CONVER/SZRAT)
+      IF(IHT .NE. 12) THEN
+        CMDSTR=' '
+        WRITE(CMDSTR,'(I3,1X,A4)') IHT,'Setf'
+        CALL PSCPUT(ISPSP,CMDSTR)
+      ENDIF
+C----
+C  CHECK IF TEXT CONTAINS ( OR ) OR "Backslash".
+C  THESE CHARACTERS ARE TREATED BY PRECEDING THEM WITH A "Backslash".
+c  DO THIS TO ( AND ) EVEN THOU
+C  THEY MIGHT BE BALANCED, I.E. () WITHIN A STRING, WHICH CAN BE TREATED
+C  NORMALLY.
+C----
+      NRCHAR=1
+      LINE='('
+      DO 100 ICHAR=1,NBCAR
+        IF(TEXT(ICHAR:ICHAR).EQ.'(' .OR.
+     >     TEXT(ICHAR:ICHAR).EQ.')' .OR.
+     >     TEXT(ICHAR:ICHAR).EQ.CBSL ) THEN
+          IF(NRCHAR .EQ. MXCHAR-6) THEN
+            GO TO 105
+          ENDIF
+          NRCHAR=NRCHAR+1
+          LINE(NRCHAR:NRCHAR)=CBSL
+        ENDIF
+        IF(NRCHAR .EQ. MXCHAR-6) THEN
+          GO TO 105
+        ENDIF
+        NRCHAR=NRCHAR+1
+        LINE(NRCHAR:NRCHAR)=TEXT(ICHAR:ICHAR)
+ 100  CONTINUE
+ 105  CONTINUE
+      NRCHAR=NRCHAR+1
+      LINE(NRCHAR:NRCHAR+5)=') Lend'
+C----
+C  CHARACTER SPACE HEIGHT IS 2.0 X CHAR HEIGHT
+C  CHARACTER SPACE WIDTH IS 1.5 X CHAR WIDTH
+C  ACTUAL TEXT LENGTH IS NRCHAR-2
+C  ACTUAL STRING LENGTH IS (NRCHAR-3)*1.5*CHAR WIDTH + CHAR WIDTH
+C  OR CHAR WIDHT*(1.5*NRCHAR-4.5+1)=CHAR WIDHT*(1.5*NRCHAR-3.5)
+C----
+      STRLEN=(HEIGHT*SZRAT)*(1.5*NRCHAR-3.5)
+      ANGD=ANGL*PI/180.0
+      CMDSTR=' '
+      WRITE(CMDSTR,'(F8.2,1X,A5)') XYPOS(1)*CONVER,'Xposd'
+      CALL PSCPUT(ISPSP,CMDSTR)
+      CMDSTR=' '
+      WRITE(CMDSTR,'(F8.2,1X,A5)') XYPOS(2)*CONVER,'Yposd'
+      CALL PSCPUT(ISPSP,CMDSTR)
+C----
+C  CHECH FOR VALID JUSTIFICATION.
+C  IF NOT VALID SET TO CENTERED
+C----
+      LJUST=JUST
+      IF(LJUST .LT. 0 .AND. LJUST .GT. 2) THEN
+        LJUST=0
+      ENDIF
+      XYROT(1)=COS(ANGD)*LJUST/2.
+      XYROT(2)=SIN(ANGD)*LJUST/2.
+      CADD=' '
+      CBDD=' '
+      IF(XYROT(1) .NE. 0.0 ) THEN
+        WRITE(CADD,'(1X,F7.3,1X,A6)') XYROT(1),'Xposjd'
+      ENDIF
+      IF(XYROT(2) .NE. 0.0 ) THEN
+        WRITE(CBDD,'(1X,F7.3,1X,A6)') XYROT(2),'Yposjd'
+      ENDIF
+      CMDSTR=LINE(1:NRCHAR+5)//CADD//CBDD
+      CALL PSCPUT(ISPSP,CMDSTR)
+      LINE(NRCHAR:NRCHAR+5)=') show'
+      CADD=' '
+      CBDD=' '
+      IF(ANGL.NE.0.) THEN
+        WRITE(CADD,'(1X,F7.1,1X,A7)') ANGL,'rotate '
+        WRITE(CBDD,'(1X,F7.1,1X,A7)') -ANGL,'rotate '
+      ENDIF
+      CMDSTR='xydef mover'//CADD//LINE(1:NRCHAR+5)//CBDD
+      CALL PSCPUT(ISPSP,CMDSTR)
+      CMDSTR=' '
+      WRITE(CMDSTR,'(F6.1,1X,A7)') ANGL,'Xyprset'
+      CALL PSCPUT(ISPSP,CMDSTR)
+      RETURN
+      END