File: RELATIVE:/../../../mfix.git/model/utilities_mod.f

1     MODULE utilities
2     
3       IMPLICIT NONE
4     
5     CONTAINS
6     
7     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
8     !                                                                      !
9     !  function: mfix_isnan                                                !
10     !  Purpose: check whether argument is NAN                              !
11     !                                                                      !
12     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
13     
14           LOGICAL FUNCTION mfix_isnan(x)
15     
16     !-----------------------------------------------
17     ! Dummy arguments
18     !-----------------------------------------------
19           double precision x
20     !-----------------------------------------------
21     ! Local variables
22     !-----------------------------------------------
23           CHARACTER(LEN=80) :: notnumber
24     !-----------------------------------------------
25     
26           mfix_isnan = .False.
27           WRITE(notnumber,*) x
28     ! To check for NaN's in x, see if x (a real number) contain a letter "N"
29     ! "n" or symbol "?", in which case it is a NaN (Not a Number)
30     
31           IF(INDEX(notnumber,'?') > 0 .OR.     &
32              INDEX(notnumber,'n') > 0 .OR.     &
33              INDEX(notnumber,'N') > 0 ) THEN
34             mfix_isnan = .TRUE.
35              RETURN
36           ENDIF
37     
38           RETURN
39         END FUNCTION mfix_isnan
40     
41     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
42     !                                                                      C
43     !  function: MAX_VEL_INLET                                             C
44     !  Purpose: Find maximum velocity at inlets.                           C
45     !                                                                      C
46     !  Author: S. Benyahia                                Date: 26-AUG-05  C
47     !  Reviewer:                                          Date: dd-mmm-yy  C
48     !                                                                      C
49     !  Literature/Document References:                                     C
50     !                                                                      C
51     !  Variables referenced:                                               C
52     !  Variables modified:                                                 C
53     !  Local variables:                                                    C
54     !                                                                      C
55     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
56     
57           DOUBLE PRECISION FUNCTION MAX_VEL_INLET()
58     
59     !-----------------------------------------------
60     ! Modules
61     !-----------------------------------------------
62           USE param
63           USE param1
64           USE parallel
65           USE bc
66           USE fldvar
67           USE geometry
68           USE physprop
69           USE indices
70           USE constant
71           USE run
72           USE compar
73           USE discretelement
74           USE functions
75     
76           IMPLICIT NONE
77     !-----------------------------------------------
78     ! Local variables
79     !-----------------------------------------------
80           INTEGER :: L, I, J, K, IJK, IJK2, M
81     !-----------------------------------------------
82     
83     ! initializing
84           MAX_VEL_INLET = ZERO
85     
86           DO L = 1, DIMENSION_BC
87              IF (BC_DEFINED(L)) THEN
88                 IF (BC_TYPE(L) == 'MASS_INFLOW' .OR. BC_TYPE(L) == 'P_INFLOW') THEN
89     
90                    DO K = BC_K_B(L), BC_K_T(L)
91                       DO J = BC_J_S(L), BC_J_N(L)
92                          DO I = BC_I_W(L), BC_I_E(L)
93                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
94                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
95                             IJK = FUNIJK(I,J,K)
96     
97                             SELECT CASE (BC_PLANE(L))
98                             CASE ('S')
99                                IJK2 = JM_OF(IJK)
100                                IF( ABS(V_G(IJK2)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(V_G(IJK2))
101                             CASE ('N')
102                                IF( ABS(V_G(IJK)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(V_G(IJK))
103                             CASE ('W')
104                                IJK2 = IM_OF(IJK)
105                                IF( ABS(U_G(IJK2)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(U_G(IJK2))
106                             CASE ('E')
107                                IF( ABS(U_G(IJK)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(U_G(IJK))
108                             CASE ('B')
109                                IJK2 = KM_OF(IJK)
110                                IF( ABS(W_G(IJK2)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(W_G(IJK2))
111                             CASE ('T')
112                                IF( ABS(W_G(IJK)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(W_G(IJK))
113                             END SELECT
114     
115                            IF (.NOT.DES_CONTINUUM_COUPLED .OR. DES_CONTINUUM_HYBRID) THEN
116                               SELECT CASE (BC_PLANE(L))
117                                CASE ('S')
118                                   IJK2 = JM_OF(IJK)
119                                   DO M = 1, MMAX
120                                      IF( ABS(V_s(IJK2, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(V_s(IJK2, M))
121                                   ENDDO
122                                CASE ('N')
123                                   DO M = 1, MMAX
124                                     IF( ABS(V_s(IJK, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(V_s(IJK, M))
125                                   ENDDO
126                                CASE ('W')
127                                   IJK2 = IM_OF(IJK)
128                                   DO M = 1, MMAX
129                                     IF( ABS(U_s(IJK2, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(U_s(IJK2, M))
130                                   ENDDO
131                                CASE ('E')
132                                   DO M = 1, MMAX
133                                     IF( ABS(U_s(IJK, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(U_s(IJK, M))
134                                   ENDDO
135                                CASE ('B')
136                                   IJK2 = KM_OF(IJK)
137                                   DO M = 1, MMAX
138                                     IF( ABS(W_s(IJK2, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(W_s(IJK2, M))
139                                   ENDDO
140                                CASE ('T')
141                                   DO M = 1, MMAX
142                                     IF( ABS(W_s(IJK, M)) > MAX_VEL_INLET ) MAX_VEL_INLET = ABS(W_s(IJK, M))
143                                   ENDDO
144                                END SELECT
145                             ENDIF   ! end if (.not.des_continuum_coupled .or. des_continuum_hybrid)
146     
147                          ENDDO
148                       ENDDO
149                    ENDDO
150     
151                ENDIF
152              ENDIF
153           ENDDO
154     
155           RETURN
156           END FUNCTION MAX_VEL_INLET
157     
158     
159     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
160     !                                                                      C
161     !  Function: CHECK_VEL_BOUND()                                         C
162     !  Purpose: Check velocities upper bound to be less than speed of      C
163     !           sound                                                      C
164     !                                                                      C
165     !  Author: S. Benyahia                                Date: 25-AUG-05  C
166     !  Reviewer:                                          Date: dd-mmm-yy  C
167     !                                                                      C
168     !                                                                      C
169     !  Literature/Document References:                                     C
170     !                                                                      C
171     !  Variables referenced:                                               C
172     !  Variables modified:                                                 C
173     !  Local variables:                                                    C
174     !                                                                      C
175     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
176     
177           LOGICAL FUNCTION CHECK_VEL_BOUND ()
178     
179     !-----------------------------------------------
180     ! Modules
181     !-----------------------------------------------
182           USE param
183           USE param1
184           USE parallel
185           USE fldvar
186           USE bc
187           USE geometry
188           USE physprop
189           USE indices
190           USE run
191           USE toleranc
192           USE compar
193           USE mpi_utility
194           USE discretelement
195           USE functions
196     
197           IMPLICIT NONE
198     !-----------------------------------------------
199     ! Local variables
200     !-----------------------------------------------
201           INTEGER :: M
202     ! Indices
203           INTEGER :: IJK
204           LOGICAL :: ALL_IS_ERROR
205     !-----------------------------------------------
206     
207     !!$omp   parallel do private(IJK)
208     ! initializing
209           CHECK_VEL_BOUND = .FALSE.
210           ALL_IS_ERROR    = .FALSE.
211     
212     LOOP_FLUID : DO IJK = IJKSTART3, IJKEND3
213     
214              IF (FLUID_AT(IJK)) THEN
215                 IF(ABS(U_G(IJK)) > MAX_INLET_VEL .OR. &
216                    ABS(V_G(IJK)) > MAX_INLET_VEL .OR. &
217                    ABS(W_G(IJK)) > MAX_INLET_VEL) THEN
218                    CHECK_VEL_BOUND = .TRUE.
219                    WRITE(*,1000) MAX_INLET_VEL, I_OF(IJK), J_OF(IJK), K_OF(IJK), &
220                                  EP_g(IJK), U_G(IJK), V_G(IJK), W_G(IJK)
221                    EXIT LOOP_FLUID
222                 ENDIF
223     
224                 IF (.NOT.DES_CONTINUUM_COUPLED .OR. DES_CONTINUUM_HYBRID) THEN
225                    DO M = 1, MMAX
226                      IF(ABS(U_S(IJK,M)) > MAX_INLET_VEL .OR. &
227                         ABS(V_S(IJK,M)) > MAX_INLET_VEL .OR. &
228                         ABS(W_S(IJK,M)) > MAX_INLET_VEL) THEN
229                        CHECK_VEL_BOUND = .TRUE.
230                        WRITE(*,1010) MAX_INLET_VEL, I_OF(IJK), J_OF(IJK), K_OF(IJK), M, &
231                                      EP_s(IJK, M), U_S(IJK,M), V_S(IJK,M), W_S(IJK,M)
232                        EXIT LOOP_FLUID
233                      ENDIF
234                    ENDDO
235                 ENDIF   ! end if(.not.des_continuum_coupled or des_continuum_hybrid)
236              ENDIF
237     
238           ENDDO LOOP_FLUID
239     
240           CALL GLOBAL_ALL_OR(CHECK_VEL_BOUND, ALL_IS_ERROR)
241           IF(ALL_IS_ERROR) CHECK_VEL_BOUND = .TRUE.
242     
243           RETURN
244      1000 FORMAT(1X,'Message from: CHECK_VEL_BOUND',/&
245                 'WARNING: velocity higher than maximum allowed velocity: ', &
246                 G12.5, '(to change this adjust the scale factor MAX_INLET_VEL_FAC)'/&
247                 'in this cell: ','I = ',I4,2X,' J = ',I4,2X,' K = ',I4, /&
248                 '  ','Epg = ', G12.5, 'Ug = ', G12.5, 'Vg = ', G12.5, 'Wg = ', G12.5)
249      1010 FORMAT(1X,'Message from: CHECK_VEL_BOUND',/&
250                 'WARNING: velocity higher than maximum allowed velocity: ', &
251                 G12.5,/&
252                 'in this cell: ','I = ',I4,2X,' J = ',I4,2X,' K = ',I4,' M = ',I4, /&
253                 '  ','Eps = ', G12.5,'Us = ', G12.5, 'Vs = ', G12.5, 'Ws = ', G12.5)
254     
255           END FUNCTION CHECK_VEL_BOUND
256     
257     
258     
259     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
260     !                                                                      C
261     !  Function name: SEEK_COMMENT (LINE_MAXCOL)                           C
262     !  Purpose: determine if (and where) a comment character appears       C
263     !           in a data input line                                       C
264     !                                                                      C
265     !  Author: P.Nicoletti                                Date: 25-NOV-91  C
266     !  Reviewer: M.SYAMLAL, W.ROGERS, P.NICOLETTI         Date: 24-JAN-92  C
267     !                                                                      C
268     !  Revision Number:                                                    C
269     !  Purpose:                                                            C
270     !  Author:                                            Date: dd-mmm-yy  C
271     !  Reviewer:                                          Date: dd-mmm-yy  C
272     !                                                                      C
273     !  Literature/Document References:                                     C
274     !                                                                      C
275     !  Variables referenced: None                                          C
276     !  Variables modified: SEEK_COMMENT                                    C
277     !                                                                      C
278     !  Local variables: DIM_COMMENT, COMMENT_CHAR, L, COMMENT, L2          C
279     !                                                                      C
280     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
281     !
282           INTEGER FUNCTION SEEK_COMMENT (LINE, MAXCOL)
283     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
284     !...Switches: -xf
285           IMPLICIT NONE
286     !-----------------------------------------------
287     !   D u m m y   A r g u m e n t s
288     !-----------------------------------------------
289     !
290     !                   input data line
291           CHARACTER(len=*) LINE
292     !
293     !                   maximum column of input data line to search
294           INTEGER       MAXCOL
295     !
296     !-----------------------------------------------
297     !   L o c a l   P a r a m e t e r s
298     !-----------------------------------------------
299     !
300     !                   the number of designated comment characters
301           INTEGER, PARAMETER :: DIM_COMMENT = 2
302     !-----------------------------------------------
303     !   L o c a l   V a r i a b l e s
304     !-----------------------------------------------
305     !
306     !                   loop indicies
307           INTEGER :: L, L2
308     !
309     !                   the comment characters
310           CHARACTER, DIMENSION(DIM_COMMENT) :: COMMENT_CHAR
311     !-----------------------------------------------
312     !
313     !     The function SEEK_COMMENT returns the index to where a comment
314     !     character was found in the input data line.  Equals MAXCOL + 1
315     !     if no-comment characters in the line
316     !
317     !
318           DATA COMMENT_CHAR/'#', '!'/
319     !
320           DO L = 1, MAXCOL
321              DO L2 = 1, DIM_COMMENT
322                 IF (LINE(L:L) == COMMENT_CHAR(L2)) THEN
323                    SEEK_COMMENT = L
324                    RETURN
325                 ENDIF
326              END DO
327           END DO
328           SEEK_COMMENT = MAXCOL + 1
329     !
330           RETURN
331           END FUNCTION SEEK_COMMENT
332     
333     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
334     !                                                                      C
335     !  Function name: SEEK_END (LINE, MAXCOL)                              C
336     !  Purpose: determine where trailing blanks begin in a line            C
337     !                                                                      C
338     !  Author: P.Nicoletti, M. Syamlal                    Date: 7-AUG-92   C
339     !  Reviewer: M. Syamlal                               Date: 11-DEC-92  C
340     !                                                                      C
341     !  Literature/Document References:                                     C
342     !                                                                      C
343     !  Variables referenced: None                                          C
344     !  Variables modified: SEEK_END                                        C
345     !                                                                      C
346     !  Local variables: L                                                  C
347     !                                                                      C
348     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
349     !
350           INTEGER FUNCTION SEEK_END (LINE, MAXCOL)
351     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
352     !...Switches: -xf
353           IMPLICIT NONE
354     !-----------------------------------------------
355     !   D u m m y   A r g u m e n t s
356     !-----------------------------------------------
357     !
358     !                   maximum column of input data line to search
359           INTEGER MAXCOL
360     !
361     !                   input data line
362           CHARACTER LINE*(*)
363     !-----------------------------------------------
364     !   L o c a l   V a r i a b l e s
365     !-----------------------------------------------
366           INTEGER :: L
367     !-----------------------------------------------
368     !
369     !     The function SEEK_END returns the index to where the last
370     !     character was found in the input data line.  Equals MAXCOL
371     !     if no trailing blank characters in the line
372     !
373     !
374           SEEK_END = 0
375           DO L = 1, MAXCOL
376              IF (LINE(L:L) /= ' ') SEEK_END = L
377           END DO
378           RETURN
379           END FUNCTION SEEK_END
380     
381     !
382     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
383     !                                                                      C
384     !  Function name: LINE_TOO_BIG (LINE,LINE_LEN,MAXCOL)                  C
385     !  Purpose: return an error condition if input data is located past    C
386     !           column MAXCOL in the data input file                       C
387     !                                                                      C
388     !  Author: P.Nicoletti                                Date: 25-NOV-91  C
389     !  Reviewer: M.SYAMLAL, W.ROGERS, P.NICOLETTI         Date: 24-JAN-92  C
390     !                                                                      C
391     !  Revision Number:                                                    C
392     !  Purpose:                                                            C
393     !  Author:                                            Date: dd-mmm-yy  C
394     !  Reviewer:                                          Date: dd-mmm-yy  C
395     !                                                                      C
396     !  Literature/Document References:                                     C
397     !                                                                      C
398     !  Variables referenced: None                                          C
399     !  Variables modified: LINE_TOO_BIG                                    C
400     !                                                                      C
401     !  Local variables: L                                                  C
402     !                                                                      C
403     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
404     !
405           INTEGER FUNCTION LINE_TOO_BIG (LINE, LINE_LEN, MAXCOL)
406     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
407     !...Switches: -xf
408           IMPLICIT NONE
409     !-----------------------------------------------
410     !   D u m m y   A r g u m e n t s
411     !-----------------------------------------------
412     !
413     !                   input data line
414           CHARACTER(LEN=*) :: LINE
415     !
416     !                   length of input data line
417           INTEGER       LINE_LEN
418     !
419     !                   maximum column that non-blank charcaters are
420     !                   are in the input data line
421           INTEGER       MAXCOL
422     !-----------------------------------------------
423     !   L o c a l   V a r i a b l e s
424     !-----------------------------------------------
425     !
426     !               loop index
427           INTEGER :: L
428     !-----------------------------------------------
429     !
430     !     The function LINE_TOO_BIG returns a value greater than 0 to
431     !     indicate an error condition (data passed column MAXCOL in LINE)
432     !
433     !
434           DO L = MAXCOL + 1, LINE_LEN
435              IF (LINE(L:L) /= ' ') THEN
436                 LINE_TOO_BIG = L
437                 RETURN
438              ENDIF
439           END DO
440           LINE_TOO_BIG = 0
441           RETURN
442           END FUNCTION LINE_TOO_BIG
443     
444     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
445     !                                                                      !
446     ! Function: BLANK_LINE                                                !
447     ! Author: P. Nicoletti                                Date: 25-NOV-91  !
448     !                                                                      !
449     ! Purpose: Return .TRUE. if a line contains no input or only spaces.   !
450     !                                                                      !
451     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
452           LOGICAL FUNCTION BLANK_LINE (line)
453     
454           IMPLICIT NONE
455     
456           CHARACTER :: LINE*(*)
457     
458           INTEGER :: L
459     
460           BLANK_LINE = .FALSE.
461           DO L=1, len(line)
462              IF(line(L:L)/=' ' .and. line(L:L)/='    ')RETURN
463           ENDDO
464     
465           BLANK_LINE = .TRUE.
466           RETURN
467           END FUNCTION BLANK_LINE
468     
469     END MODULE utilities
470