File: /nfs/home/0/users/jenkins/mfix.git/model/equal.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: EQUAL                                                   C
4     !  Purpose: Loop on the number of solids phases to set a variable      C
5     !           equal to the value or negative value of another variable   C
6     !                                                                      C
7     !  Author: M. Syamlal                                 Date: 29-JAN-92  C
8     !  Reviewer: P. Nicoletti, W. Rogers, S. Venkatesan   Date: 29-JAN-92  C
9     !                                                                      C
10     !                                                                      C
11     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
12     
13           SUBROUTINE EQUAL(ARRAY1, IJK1, SIGN0, ARRAY2, IJK2)
14     
15     !-----------------------------------------------
16     ! Modules
17     !-----------------------------------------------
18           USE param
19           USE param1
20           USE indices
21           USE physprop, only : MMAX
22           IMPLICIT NONE
23     !-----------------------------------------------
24     ! Dummy arguments
25     !-----------------------------------------------
26     ! First array
27           DOUBLE PRECISION, INTENT(OUT) :: ARRAY1 (DIMENSION_3, *)
28     ! Second array
29           DOUBLE PRECISION, INTENT(IN) :: ARRAY2 (DIMENSION_3, *)
30     ! IJK index for the first array
31           INTEGER, INTENT(IN) :: IJK1
32     ! IJK index for the second array
33           INTEGER, INTENT(IN) :: IJK2
34     ! Sign to be used when setting ARRAY1.  Legal values
35     ! are + or - 1.0.
36           DOUBLE PRECISION, INTENT(IN) :: SIGN0
37     !-----------------------------------------------
38     ! Local variables
39     !-----------------------------------------------
40     !-----------------------------------------------
41     
42           IF (MMAX > 0) THEN
43              ARRAY1(IJK1,:MMAX) = SIGN0*ARRAY2(IJK2,:MMAX)
44           ENDIF
45     
46           RETURN
47           END SUBROUTINE EQUAL
48