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 --- Donjon/src/SIMQMP.f | 135 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 135 insertions(+) create mode 100644 Donjon/src/SIMQMP.f (limited to 'Donjon/src/SIMQMP.f') diff --git a/Donjon/src/SIMQMP.f b/Donjon/src/SIMQMP.f new file mode 100644 index 0000000..9143a89 --- /dev/null +++ b/Donjon/src/SIMQMP.f @@ -0,0 +1,135 @@ +*DECK SIMQMP + SUBROUTINE SIMQMP(LX,LY,LXMIN,LYMIN,HHX,IHY,CYCLE) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Unfold the quarter shuffling map to full shuffling map, using +* rotations around the center. +* +*Copyright: +* Copyright (C) 2013 Ecole Polytechnique de Montreal +* +*Author(s): +* V. Salino +* +*Parameters: input +* LX number of assemblies along the X axis. +* LY number of assemblies along the Y axis. +* LXMIN coordinates on X axis of the first assembly. +* LYMIN coordinates on Y axis of the first assembly. +* HHX naval battle indices along X axis. +* IHY naval battle indices along Y axis. +* +*Parameters: input/output +* CYCLE shuffling matrix for refuelling given as a quarter map, +* and returned as a full reconstructed matrix +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER LX,LY,LXMIN,LYMIN,IHY(LY) + CHARACTER HHX(LX)*1,CYCLE(LX,LY)*4 +*---- +* LOCAL VARIABLES +* ROTMAT counter-clockwise rotation matrices, with an Y-axis directed +* downward. +* ROTMAT(x,x,1) < 90 degrees rotation matrix +* ROTMAT(x,x,2) < 180 degrees rotation matrix +* ROTMAT(x,x,3) < 270 degrees rotation matrix +*---- + INTEGER INTG2,XPOS,YPOS,Q + REAL XCENTER,YCENTER,ROTX(3),ROTY(3),IROT(3),JROT(3), + > ROTMAT(2,2,3) + CHARACTER TEXT4*4,TEXT1*1,RECONS(3)*4 +* + DATA ROTMAT(1,1,1), ROTMAT(1,2,1)/+0.0, +1.0/ + DATA ROTMAT(2,1,1), ROTMAT(2,2,1)/-1.0, +0.0/ +* + DATA ROTMAT(1,1,2), ROTMAT(1,2,2)/-1.0, +0.0/ + DATA ROTMAT(2,1,2), ROTMAT(2,2,2)/+0.0, -1.0/ +* + DATA ROTMAT(1,1,3), ROTMAT(1,2,3)/+0.0, -1.0/ + DATA ROTMAT(2,1,3), ROTMAT(2,2,3)/+1.0, +0.0/ +* + IF(LX.NE.LY) CALL XABORT('@SIMQMP: QMAP KEYWORD IS NOT + > COMPATIBLE WITH A NON-SQUARE REFUELLING SCHEME.') + XCENTER=(REAL(LX)+1)/2 + YCENTER=(REAL(LY)+1)/2 + DO J=LYMIN,LY + DO I=LXMIN,LX +* Excluding potential central assembly from reconstruction + IF(.NOT.(MOD(LX,2).EQ.1.AND.I.EQ.LXMIN.AND.J.EQ.LYMIN)) THEN + TEXT4=CYCLE(I,J) + DO Q=1,3 + IF((TEXT4.NE.'NEW').AND.(TEXT4.NE.'|').AND.(TEXT4.NE.'-') + > .AND.(TEXT4.NE.'-|-').AND.(TEXT4.NE.'SPC').AND. + > (TEXT4(4:).NE.'@')) THEN + READ(TEXT4,'(A1,I2)') TEXT1,INTG2 + XPOS=0 + DO K=1,LX + IF(HHX(K).EQ.TEXT1) THEN + IF(XPOS.NE.0)CALL XABORT('@SIMQMP: X-AXIS HAS ' + > //'MULTIPLE TIMES THE SAME COORDINATES. CHECK ' + > //'YOUR RESINI: CALL.') + XPOS=K + ENDIF + ENDDO + IF(XPOS.EQ.0) CALL XABORT('@SIMQMP: UNABLE TO FIND XPO' + > //'S(1).') + YPOS=0 + DO K=1,LY + IF(IHY(K).EQ.INTG2) THEN + IF(YPOS.NE.0)CALL XABORT('@SIMQMP: Y-AXIS HAS ' + > //'MULTIPLE TIMES THE SAME COORDINATES. CHECK ' + > //'YOUR RESINI: CALL.') + YPOS=K + ENDIF + ENDDO + IF(YPOS.EQ.0) CALL XABORT('@SIMQMP: UNABLE TO FIND YPO' + > //'S(2).') +* Reconstruction of an element of the matrix + ROTX(Q)=ROTMAT(1,1,Q)*(REAL(XPOS)-XCENTER) + > +ROTMAT(1,2,Q)*(REAL(YPOS)-YCENTER)+XCENTER + ROTY(Q)=ROTMAT(2,1,Q)*(REAL(XPOS)-XCENTER) + > +ROTMAT(2,2,Q)*(REAL(YPOS)-YCENTER)+YCENTER + WRITE(RECONS(Q),'(A1,I2.2)') HHX(INT(ROTX(Q))), + > IHY(INT(ROTY(Q))) + ELSE + RECONS(Q)=TEXT4 + ENDIF +* Coordinates of the assembly to be filled with +* reconstructed information + IROT(Q)=ROTMAT(1,1,Q)*(REAL(I)-XCENTER) + > +ROTMAT(1,2,Q)*(REAL(J)-YCENTER)+XCENTER + JROT(Q)=ROTMAT(2,1,Q)*(REAL(I)-XCENTER) + > +ROTMAT(2,2,Q)*(REAL(J)-YCENTER)+YCENTER + ENDDO +* + IF((J.EQ.LYMIN).AND.(MOD(LX,2).EQ.1)) THEN + IF(RECONS(3).NE.CYCLE(INT(IROT(3)),INT(JROT(3)))) THEN + WRITE(6,10) + WRITE(6,20) HHX(I),IHY(J),CYCLE(I,J),RECONS(3), + > HHX(INT(IROT(3))),IHY(INT(JROT(3))), + > CYCLE(INT(IROT(3)),INT(JROT(3))) + CALL XABORT('@SIMQMP: CHECK FOR AN ERROR IN THE QUARTE' + > //'R-MAP RELOADING PATTERN OR SWITCH TO MAP KEYWORD.') + ENDIF + ENDIF +* + DO Q=1,3 + CYCLE(INT(IROT(Q)),INT(JROT(Q)))=RECONS(Q) + ENDDO + ENDIF + ENDDO + ENDDO + RETURN +* + 10 FORMAT('@SIMQMP: INCONSISTENCY IN REDUNDANT DATA. THE ', + > 'QUARTER-MAP RELOADING PATTERN IS NOT QUARTER-SYMETRIC.') + 20 FORMAT('CONTENT OF ',A1,I2.2,' (',A4,') IS SUPPOSED TO LEAD TO "' + > ,A4,'" IN ',A1,I2.2,', BUT "',A4,'" HAS BEEN SPECIFIED ', + > 'INSTEAD.') + END -- cgit v1.2.3