summaryrefslogtreecommitdiff
path: root/Utilib/src/PSPAGE.f
diff options
context:
space:
mode:
authorstainer_t <thomas.stainer@oecd-nea.org>2025-09-08 13:48:49 +0200
committerstainer_t <thomas.stainer@oecd-nea.org>2025-09-08 13:48:49 +0200
commit7dfcc480ba1e19bd3232349fc733caef94034292 (patch)
tree03ee104eb8846d5cc1a981d267687a729185d3f3 /Utilib/src/PSPAGE.f
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Utilib/src/PSPAGE.f')
-rw-r--r--Utilib/src/PSPAGE.f60
1 files changed, 60 insertions, 0 deletions
diff --git a/Utilib/src/PSPAGE.f b/Utilib/src/PSPAGE.f
new file mode 100644
index 0000000..11a20f9
--- /dev/null
+++ b/Utilib/src/PSPAGE.f
@@ -0,0 +1,60 @@
+*DECK PSPAGE
+ SUBROUTINE PSPAGE(ISPSP,NPAGE,XYPOS)
+C
+C--------------------------- PSPAGE ---------------------------------
+C
+C 1- PROGRAMME STATISTICS:
+C NAME : PSPAGE
+C USE : SET POSTSCRIPT NEW PAGE
+C REPLACES PART OF PSPLOT ROUTINE CHOPIT
+C
+C 2- ROUTINE PARAMETERS:
+C INPUT/OUTPUT
+C ISPSP : PSP FILE UNIT I
+C NPAGE : PAGE NUMBER I
+C XYPOS : ORIGIN OF PAGE R(2)
+C--------------------------- PSPAGE --------------------------------
+C
+ IMPLICIT NONE
+ INTEGER ISPSP,NPAGE
+ REAL XYPOS(2)
+C----
+C LOCAL VARIABLES
+C----
+ INTEGER MCOLR
+ CHARACTER NAMSBR*6
+ PARAMETER (MCOLR=4,NAMSBR='PSPAGE')
+ INTEGER ICOLR
+ CHARACTER CMDSTR*132
+ REAL COLR(MCOLR)
+C----
+C INITIALIZE COLOR, XYPOS TO 0.0
+C----
+ DO 100 ICOLR=1,MCOLR
+ COLR(ICOLR)=0.0
+ 100 CONTINUE
+ CMDSTR=' '
+ WRITE(CMDSTR,'(A8,2(I4,1X))') '%%Page: ',NPAGE,NPAGE
+ CALL PSCPUT(ISPSP,CMDSTR)
+ IF(NPAGE .GT. 1) THEN
+ CMDSTR='newpath 0 0 moveto'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ ENDIF
+ CMDSTR='/Curfnt /Times-Italic findfont def'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ CMDSTR=' 12 Setf'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ IF(NPAGE .EQ. 1) THEN
+ CMDSTR=' 1.000 1.000 scale'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ ENDIF
+ CALL PSLINW(ISPSP,COLR)
+ CMDSTR=' '
+ WRITE(CMDSTR,'(F7.3,1X,A5)') 0.0,'Sgray'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ CMDSTR=' '
+ WRITE(CMDSTR,'(3(F7.3,1X),A5)') 0.0,0.0,0.0,'Scrgb'
+ CALL PSCPUT(ISPSP,CMDSTR)
+ CALL PSMOVE(ISPSP,XYPOS,-3)
+ RETURN
+ END