The TELEMAC-MASCARET system  trunk
cvsp_check_l.f
Go to the documentation of this file.
1 ! *****************************
2  RECURSIVE FUNCTION cvsp_check_l
3 ! *****************************
4 !
5  &(j,k, sometext) result(ret)
6 !
7 !***********************************************************************
8 ! SISYPHE V7P2 16/05/2017
9 !***********************************************************************
10 !
11 !brief CHECKS IF SUM OF FRACTIONS = 1 FOR
12 !+ A LAYER
13 !
14 !history UWE MERKEL, R. KOPMANN (BAW)
15 !+ 19/08/2016 / 2017
16 !+ V6P3 / V7P2
17 !
18 !history R. KOPMANN (BAW)
19 !+ 25/02/2019
20 !+ V7P2
21 !+ Removing 1/NSICLA
22 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
23 !| J |<--| INDEX OF A POINT IN MESH
24 !| K |<--| INDEX OF A LAYER
25 !| SOMETEXT |<--| DEBUGING TEXT FOR LOG-OUTPUT
26 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !
28  USE bief_def, ONLY: ncsize
29  USE bief
31  USE cvsp_outputfiles, ONLY: cp
33 !
34  IMPLICIT NONE
35 !
36 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
37 !
38  INTEGER, INTENT(IN) :: J
39  INTEGER, INTENT(IN) :: K
40  CHARACTER(LEN=10),INTENT(IN) :: SOMETEXT
41 !
42 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
43 !
44  DOUBLE PRECISION ASUM, AT
45  INTEGER I, JG
46  LOGICAL RET
47 !
48 !-----------------------------------------------------------------------
49 !
50  at = dt*lt/percou
51  jg = j
52  IF (ncsize > 1) jg = mesh%KNOLG%I(j)
53 !
54  ret = .true.
55 
56  asum = 0.d0
57 !
58 !-----------------------------------------------------------------------
59 !SUM UP AND SLIGHT CORRECTION
60 !-----------------------------------------------------------------------
61 !
62  DO i=1,nsicla
63  asum = avail(j,k,i) + asum
64  IF ((avail(j,k,i)>1.d0+zero)) THEN
65  IF(cp) WRITE(lu,*)
66  & 'CVSP CL: AVAIL>1: WARN,LT,Pnt_J;Lay_K;F_I;%: '
67  & ,sometext,lt,jg,k,i,pro_f(j,k,i)
68  ENDIF
69 !
70  IF ((avail(j,k,i)<0.d0-zero)) THEN
71  IF(cp) WRITE(lu,*)
72  & 'CVSP CL: AVAIL<0: WARN,LT,Pnt_J;Lay_K;F_I;%: '
73  & ,sometext,lt,jg,k,i,pro_f(j,k,i)
74  ENDIF
75  ENDDO
76 !
77  IF (abs(asum-1.0d0)>zero.AND.asum.GT.0.d0) THEN
78  IF ((abs(asum-1.0d0)>1.d-6).AND.(asum.GT.0.d0)) THEN
79  DO i=1,nsicla
80  avail(j,k,i) = avail(j,k,i) / asum
81  END DO
82  IF (lt.GT.0) THEN
83  IF(cp) WRITE(lu,*)
84  & 'CVSP CL: |SUM_ERR|: WARN,LT,J;K;SUM: '
85  & ,sometext,lt,jg,k,asum
86  ret = .false.
87  ENDIF
88  ENDIF
89  END IF
90 
91 
92  IF (abs(asum)<zero.AND.asum.GT.0.d0) THEN
93 ! WRITE(LU,*) 'CVSP CL: |SUM_ZERO|: WARN,LT,Pnt_J;Lay_K;F_I;SUM:'
94 ! & ,SOMETEXT,LT,JG,K,I,ASUM
95  DO i=1,nsicla
96  avail(j,k,i) = 0.d0
97  END DO
98  ret = .false.
99  END IF
100 !
101 !-----------------------------------------------------------------------
102 !
103  IF (ret.EQV..false.) THEN
104  ret = cvsp_check_l(j,k,'ReCheck ')
105  ENDIF
106 !
107 !-----------------------------------------------------------------------
108  RETURN
109  END FUNCTION cvsp_check_l
double precision, dimension(:,:,:), allocatable, target pro_f
integer ncsize
Definition: bief_def.f:49
double precision, target dt
double precision, dimension(:,:,:), allocatable, target avail
recursive logical function cvsp_check_l(J, K, SOMETEXT)
Definition: cvsp_check_l.f:7
type(bief_mesh), target mesh
Definition: bief.f:3