summaryrefslogtreecommitdiff
path: root/Donjon/src/SIMQMP.f
blob: 9143a898f3535ab8070445e1fb0589ed2474093d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
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