Inequality_tests/RANGE.f at master · everest-ey/Inequality_tests · GitHub

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
      SUBROUTINE RANGE( IELEMN, TRANSP, W1, W2, nelvar, ninvar,
     *                  itype, LW1, LW2 )
      INTEGER IELEMN, nelvar, ninvar, itype, LW1, LW2
      LOGICAL TRANSP
      DOUBLE PRECISION W1( LW1 ), W2( LW2 )
C
C  Problem name : BT11
C
C  -- produced by SIFdecode 1.0
C
C  TRANSP = .FALSE. <=> W2 = U * W1
C  TRANSP = .TRUE.  <=> W2 = U(transpose) * W1
C
      INTEGER I
      GO TO (99998,99998,99998,    4,    5
     *                                                        ), ITYPE
C
C  Element type : ISQ
C
    4 CONTINUE
      IF ( TRANSP ) THEN
         W2(     1 ) =   W1(     1 )
         W2(     2 ) = - W1(     1 )
      ELSE
         W2(     1 ) =   W1(     1 )
     *                 - W1(     2 )
      END IF
      RETURN
C
C  Element type : IFR
C
    5 CONTINUE
      IF ( TRANSP ) THEN
         W2(     1 ) =   W1(     1 )
         W2(     2 ) = - W1(     1 )
      ELSE
         W2(     1 ) =   W1(     1 )
     *                 - W1(     2 )
      END IF
      RETURN
C
C  Elements without internal variables.
C
99998 CONTINUE
      DO 99999 i = 1, nelvar
         W2( i ) = W1( i )
99999 CONTINUE
      RETURN
      END