From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Utilib/src/PSFARC.f | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 Utilib/src/PSFARC.f (limited to 'Utilib/src/PSFARC.f') diff --git a/Utilib/src/PSFARC.f b/Utilib/src/PSFARC.f new file mode 100644 index 0000000..568a536 --- /dev/null +++ b/Utilib/src/PSFARC.f @@ -0,0 +1,40 @@ +*DECK PSFARC + SUBROUTINE PSFARC(ISPSP,XYCENT,RADIUS,ANGR) +C +C--------------------------- PSFARC --------------------------------- +C +C 1- PROGRAMME STATISTICS: +C NAME : PSFARC +C USE : FILL ARC +C REPLACES PSPLOT ROUTINE ARC +C +C 2- ROUTINE PARAMETERS: +C INPUT/OUTPUT +C ISPSP : PSP FILE UNIT I +C YXCENT : POSITION (X,Y) OF LINE INTERSECTION R(2) +C RADIUS : ARC RADIUS R +C ANGR : ARC ANGLE RANGE R(2) +C +C--------------------------- PSFARC -------------------------------- +C + IMPLICIT NONE + INTEGER ISPSP + REAL XYCENT(2),RADIUS,ANGR(2) +C---- +C LOCAL VARIABLES +C---- + CHARACTER NAMSBR*6 + REAL CONVER + PARAMETER (NAMSBR='PSFARC',CONVER=72.0) + CHARACTER CMDSTR*132 + CMDSTR='Np' + CALL PSCPUT(ISPSP,CMDSTR) + CMDSTR=' ' + WRITE(CMDSTR,'(5(F8.2,1X),A3)') + > XYCENT(1)*CONVER,XYCENT(2)*CONVER,RADIUS*CONVER, + > ANGR(1),ANGR(2),'arc' + CALL PSCPUT(ISPSP,CMDSTR) + CMDSTR='cf' + CALL PSCPUT(ISPSP,CMDSTR) + RETURN + END -- cgit v1.2.3