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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  SUBROUTINE: GET_PS                                                  !
4     !  Author: J.Musser                                   Date: 19-MAR-14  !
5     !                                                                      !
6     !  Purpose: Find and validate i, j, k locations for PS's               !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE GET_PS(PSV)
10     
11           USE param
12           USE param1
13           USE geometry
14           USE ps
15           USE indices
16           USE funits
17           USE compar
18     
19     ! Use the error manager for posting error messages.
20     !---------------------------------------------------------------------//
21           use error_manager
22     
23           IMPLICIT NONE
24     
25     ! Dummy Arguments:
26     !---------------------------------------------------------------------//
27     ! Loop/variable indices
28           INTEGER, INTENT(in) :: PSV
29     
30     ! Local Variables:
31     !---------------------------------------------------------------------//
32     ! Error flag.
33           INTEGER :: IER
34     ! Calculated indices of the wall boundary
35           INTEGER :: I_w , I_e , J_s , J_n , K_b , K_t
36     ! Surface indictors
37           LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT
38     !......................................................................!
39     
40           CALL INIT_ERR_MSG('GET_PS')
41     
42           X_CONSTANT = .TRUE.
43           Y_CONSTANT = .TRUE.
44           Z_CONSTANT = .TRUE.
45     
46           IF(PS_X_W(PSV)/=UNDEFINED .AND. PS_X_E(PSV)/=UNDEFINED) THEN
47              CALL CALC_CELL(XMIN, PS_X_W(PSV), DX, IMAX, I_W)
48              CALL CALC_CELL(XMIN, PS_X_E(PSV), DX, IMAX, I_E)
49              IF (PS_X_W(PSV) /= PS_X_E(PSV)) THEN
50                 X_CONSTANT = .FALSE.
51                 I_W = I_W + 1
52                 IF(PS_I_W(PSV)/=UNDEFINED_I .OR.                           &
53                    PS_I_E(PSV)/=UNDEFINED_I) THEN
54                    CALL LOCATION_CHECK(PS_I_W(PSV), I_W, PSV, 'PS - west')
55                    CALL LOCATION_CHECK(PS_I_E(PSV), I_E, PSV, 'PS - east')
56                 ENDIF
57              ENDIF
58              PS_I_W(PSV) = I_W
59              PS_I_E(PSV) = I_E
60           ELSE
61              IF(PS_I_W(PSV) /= UNDEFINED_I)                                &
62                 CALL CALC_LOC(XMIN, DX, PS_I_W(PSV), PS_X_W(PSV))
63              IF(PS_I_E(PSV) /= UNDEFINED_I)                                &
64                 CALL CALC_LOC(XMIN, DX, PS_I_E(PSV), PS_X_E(PSV))
65              IF (PS_X_W(PSV) /= PS_X_E(PSV)) X_CONSTANT = .FALSE.
66           ENDIF
67     
68     !  If there is no variation in the I direction set indices to 1
69           IF (NO_I) THEN
70              PS_I_W(PSV) = 1
71              PS_I_E(PSV) = 1
72           ENDIF
73     !
74           IF (PS_Y_S(PSV)/=UNDEFINED .AND. PS_Y_N(PSV)/=UNDEFINED) THEN
75              CALL CALC_CELL(ZERO, PS_Y_S(PSV), DY, JMAX, J_S)
76              CALL CALC_CELL(ZERO, PS_Y_N(PSV), DY, JMAX, J_N)
77              IF (PS_Y_S(PSV) /= PS_Y_N(PSV)) THEN
78                 Y_CONSTANT = .FALSE.
79                 J_S = J_S + 1
80                 IF(PS_J_S(PSV)/=UNDEFINED_I .OR.                           &
81                    PS_J_N(PSV)/=UNDEFINED_I) THEN
82                    CALL LOCATION_CHECK(PS_J_S(PSV), J_S, PSV, 'PS - south')
83                    CALL LOCATION_CHECK(PS_J_N(PSV), J_N, PSV, 'PS - north')
84                 ENDIF
85              ENDIF
86              PS_J_S(PSV) = J_S
87              PS_J_N(PSV) = J_N
88           ELSE
89              IF(PS_J_S(PSV) /= UNDEFINED_I)                                &
90                 CALL CALC_LOC(ZERO, DY, PS_J_S(PSV), PS_Y_S(PSV))
91              IF(PS_J_N(PSV) /= UNDEFINED_I)                                &
92                 CALL CALC_LOC(ZERO, DY, PS_J_N(PSV), PS_Y_N(PSV))
93              IF (PS_Y_S(PSV) /= PS_Y_N(PSV)) Y_CONSTANT = .FALSE.
94           ENDIF
95     
96     ! If there is no variation in the J direction set indices to 1
97           IF (NO_J) THEN
98              PS_J_S(PSV) = 1
99              PS_J_N(PSV) = 1
100           ENDIF
101     
102           IF (PS_Z_B(PSV)/=UNDEFINED .AND. PS_Z_T(PSV)/=UNDEFINED) THEN
103              CALL CALC_CELL(ZERO, PS_Z_B(PSV), DZ, KMAX, K_B)
104              CALL CALC_CELL(ZERO, PS_Z_T(PSV), DZ, KMAX, K_T)
105              IF (PS_Z_B(PSV) /= PS_Z_T(PSV)) THEN
106                 Z_CONSTANT = .FALSE.
107                 K_B = K_B + 1
108                 IF (PS_K_B(PSV)/=UNDEFINED_I .OR.                          &
109                    PS_K_T(PSV)/=UNDEFINED_I) THEN
110                    CALL LOCATION_CHECK(PS_K_B(PSV), K_B, PSV, 'PS - bottom')
111                    CALL LOCATION_CHECK(PS_K_T(PSV), K_T, PSV, 'PS - top')
112                 ENDIF
113              ENDIF
114              PS_K_B(PSV) = K_B
115              PS_K_T(PSV) = K_T
116           ELSE
117              IF(PS_K_B(PSV) /= UNDEFINED_I)                                &
118                 CALL CALC_LOC(ZERO, DZ, PS_K_B(PSV), PS_Z_B(PSV))
119              IF(PS_K_T(PSV) /= UNDEFINED_I)                                &
120                 CALL CALC_LOC(ZERO, DZ, PS_K_T(PSV), PS_Z_T(PSV))
121              IF (PS_Z_B(PSV) /= PS_Z_T(PSV)) Z_CONSTANT = .FALSE.
122           ENDIF
123     
124     !  If there is no variation in the K direction set indices to 1
125           IF (NO_K) THEN
126              PS_K_B(PSV) = 1
127              PS_K_T(PSV) = 1
128           ENDIF
129     
130     ! CHECK FOR VALID VALUES
131           IER = 0
132           IF(PS_I_W(PSV)<1 .OR. PS_I_W(PSV)>IMAX2) IER = 1
133           IF(PS_I_E(PSV)<1 .OR. PS_I_E(PSV)>IMAX2) IER = 1
134           IF(PS_J_S(PSV)<1 .OR. PS_J_S(PSV)>JMAX2) IER = 1
135           IF(PS_J_N(PSV)<1 .OR. PS_J_N(PSV)>JMAX2) IER = 1
136           IF(PS_K_B(PSV)<1 .OR. PS_K_B(PSV)>KMAX2) IER = 1
137           IF(PS_K_T(PSV)<1 .OR. PS_K_T(PSV)>KMAX2) IER = 1
138           IF(PS_K_B(PSV) > PS_K_T(PSV)) IER = 1
139           IF(PS_J_S(PSV) > PS_J_N(PSV)) IER = 1
140           IF(PS_I_W(PSV) > PS_I_E(PSV)) IER = 1
141     
142           IF(IER /= 0)THEN
143              WRITE(ERR_MSG,1101) PSV,                                      &
144                 'X', PS_X_W(PSV), PS_X_E(PSV),'I',PS_I_W(PSV),PS_I_E(PSV), &
145                 'Y', PS_Y_S(PSV), PS_Y_N(PSV),'J',PS_J_S(PSV),PS_J_N(PSV), &
146                 'Z', PS_Z_B(PSV), PS_Z_T(PSV),'K',PS_K_B(PSV),PS_K_T(PSV)
147              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
148           ENDIF
149     
150      1101 FORMAT('Error 1101: Invalid location specified for PS ',I3,'.',  &
151              3(/3x,A1,': ',g12.5,',',g12.5,8x,A1,': ',I8,',',I8),/         &
152              'Please correct the mfix.dat file.')
153     
154           CALL FINL_ERR_MSG
155     
156           RETURN
157           END SUBROUTINE GET_PS
158