diff options
Diffstat (limited to 'Donjon/src/RODMOV.f')
| -rw-r--r-- | Donjon/src/RODMOV.f | 72 |
1 files changed, 72 insertions, 0 deletions
diff --git a/Donjon/src/RODMOV.f b/Donjon/src/RODMOV.f new file mode 100644 index 0000000..52a6df2 --- /dev/null +++ b/Donjon/src/RODMOV.f @@ -0,0 +1,72 @@ +*DECK RODMOV + SUBROUTINE RODMOV(IPMAP,NGRP,RNAME,INS) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Modify rod insertion (second call) +* +*Copyright: +* Copyright (C) 2017 Ecole Polytechnique de Montreal. +* +*Author(s): +* G. Tixier +* +*Parameters: input +* IPMAP pointer to the fuel map +* NGRP number of rod groups +* RNAME name of rod group +* INS rod insertion for each rod group +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMAP + INTEGER NGRP + REAL INS(NGRP) + CHARACTER(LEN=3) RNAME(NGRP) +*---- +* LOCAL VARIABLES +*---- + INTEGER I,J,NRMV + REAL FLOT + REAL INS2(NGRP) + CHARACTER(LEN=3) RNAME2(NGRP) + TYPE(C_PTR) MPMAP + CHARACTER TEXT*3 + DOUBLE PRECISION DFLOT +* + MPMAP=LCMGID(IPMAP,'ROD-INFO') + CALL LCMGTC(MPMAP,'ROD-NAME',3,NGRP,RNAME) + CALL LCMGET(MPMAP,'ROD-INSERT',INS) + CALL REDGET(ITYP,NRMV,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@RODMOV: INTEGER' + 1 //' DATA FOR GROUP NUMBER EXPECTED.') + J=1 + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@RODMOV: CHARACTER DATA EXPECTED.') + DO WHILE(J.LE.NGRP) + RNAME2(J)=TEXT + I=1 + DO WHILE (I.LE.NRMV) + RNAME2(I)=TEXT + IF(RNAME2(I).EQ.RNAME(J)) THEN + CALL REDGET(ITYP,NITMA,INS2(J),TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@RODMOV: REAL DA' + 1 //'TA FOR INS EXPECTED.') + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@RODMOV: CHARACTER DATA EXPECTED.') + GO TO 10 + ELSE + I=I+1 + ENDIF + END DO + INS2(J)=INS(J) + 10 J=J+1 + END DO + CALL LCMPUT(MPMAP,'ROD-INSERT',NGRP,2,INS2) + RETURN + END |