The TELEMAC-MASCARET system  trunk
cvsp_check_f_gaia.f
Go to the documentation of this file.
1 ! ************************************
2  RECURSIVE FUNCTION cvsp_check_f_gaia
3 ! ************************************
4 !
5  &(j,k, sometext) result(ret)
6 !
7 !***********************************************************************
8 ! GAIA V8P1 16/05/2017
9 !***********************************************************************
10 !
13 !
17 !
22 !
27 !
32 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
36 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
37 !
38  USE bief_def, ONLY : ncsize
39  USE bief
41  USE cvsp_outputfiles_gaia, ONLY: cp
42 !
44  IMPLICIT NONE
45 !
46 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
47 !
48  INTEGER, INTENT(IN) :: J
49  INTEGER, INTENT(IN) :: K
50  CHARACTER(LEN=10),INTENT(IN) :: SOMETEXT
51 !
52 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
53 !
54  DOUBLE PRECISION TEMP, AT, ERRTOCORR
55  INTEGER I, JG, II
56  LOGICAL RET
57 !-----------------------------------------------------------------------
58  at = dt*lt/percou
59  jg = j
60  IF (ncsize > 1) jg = mesh%KNOLG%I(j)
61  ret = .true.
62  temp = 0.d0
63 !-----------------------------------------------------------------------
64 !SUM UP AND SLIGHT CORRECTION
65 !-----------------------------------------------------------------------
66  DO i=1,nsicla
67  IF (pro_f(j,k,i).LT.0.d0) THEN
68  IF (pro_f(j,k,i).LE.-1.d-7.AND.cp) WRITE(lu,*)
69  & 'CVSP CF:PRO_F<0: WARN,J;K;F_I;%: ',
70  & sometext,jg,k,i,pro_f(j,k,i)
71  IF(pro_f(j,k,i).GE.-1.d-3) THEN
72  pro_f(j,k,i) = 0.d0
73  ELSE
74  CALL cvsp_p_gaia('./','PRO_F.lt'//sometext, j)
75  WRITE(lu,*) 'CVSP CF:PRO_F<0: ERR,LT,J;K;F_I;%: '
76  & ,sometext,lt,jg,k,i,pro_f(j,k,i)
77  CALL plante(1)
78  stop
79  ENDIF
80  ENDIF
81 !RK PRO_F > 1
82  IF (pro_f(j,k,i).GT.1.d0) THEN
83  IF ((1.d0-pro_f(j,k,i)).LE.-1.d-7.AND.cp) WRITE(lu,*)
84  & 'CVSP CF:PRO_F>1: WARN,J;K;F_I;%: ',
85  & sometext,jg,j,k,i,pro_f(j,k,i)
86 ! IF((1.D0-PRO_F(J,K,I)).GE.-1.D-3) THEN
87 ! This barrier is quite low, as it is a numerical problem in rm_fraction
88 ! if a fraction of value nearly 1 is removed than the "normalising procedure" is not very
89 ! precise as it is diveded by (1-reomoved fraction) which can be nearly zero...
90  IF((1.d0-pro_f(j,k,i)).GE.-1.d0) THEN
91  pro_f(j,k,i) = 1.d0
92  ELSE
93  CALL cvsp_p_gaia('./','PRO_F.gt'//sometext, j)
94  WRITE(lu,*) 'CVSP CF:PRO_F>1: ERR,LT,J;K;F_I;%: '
95  & ,sometext,lt,jg,k,i,pro_f(j,k,i),pro_max(j)
96  CALL plante(1)
97  stop
98  ENDIF
99  ENDIF
100  temp = temp + pro_f(j,k,i)
101  ENDDO
102 ! ALL FRACTION ZERO IS OK, IN CVSP_MAIN this section will be deleted
103  IF(temp.EQ.0.d0) THEN
104  temp = 1.d0
105  ENDIF
106 !-----------------------------------------------------------------------
107 ! CHECK AND CORRECT DEVIATIONS
108 !-----------------------------------------------------------------------
109  IF(abs(temp-1.d0).GT.0.d0) THEN
110  IF(abs(temp).LT.1.d-6) THEN
111 ! SEVERE ERROR, FOR DEBUGGING ONLY RESET to 1 / NSICLA
112  IF(cp) WRITE(lu,*) 'CVSP CF: |SUM_ERR|~0;LT;J;K;SUM:'
113  & ,sometext,lt,jg,k,temp
114  ret = .false.
115  IF(cp) WRITE(lu,*) 'CVSP --> NSICLA: ', nsicla
116  DO i=1,nsicla
117  IF(cp) WRITE(lu,*) 'CVSP --> ;LT;Pnt_J;Lay_K;F_I,%: '
118  & ,lt,jg,k,i,pro_f(j,k,i)
119  pro_f(j,k,i) = 0.d0
120  ENDDO
121  ELSEIF(abs(temp-1.d0).GT.1.d-6) THEN
122 !STRONG DIFFERENCES ARE CORRECTED BY NORMALIZING ALL FRACTIONS
123 !!!!!!!!!!! README!
124 !The following warning occured in 0.00025 of all cases
125 !In almost every case |SUM_ERR| < 2*1.D-5
126 !To remove this remaining errors would cost 2-3 times higher
127 !computational expense with no significant global effects
128 !So the following warning is just meant to remember you on truncation errors
129 !that still exist
130  IF(abs(temp-1.d0).GT.5.d-5) THEN
131  IF(cp) WRITE(lu,*) 'CVSP CF: |SUM_ERR|>1.-5 ;LT;J;K;SUM:'
132  & ,sometext,lt,jg,k,temp
133  ENDIF
134  ret = .false.
135  DO i=1,nsicla
136  IF(pro_f(j,k,i).GT.0.d0) THEN
137  pro_f(j,k,i) = pro_f(j,k,i) / temp
138  ENDIF
139  ENDDO
140  ELSE
141 ! SLIGHT DIFFERENCES TO 0 ARE CORRECTED BY CHANGING ONLY
142 ! THE FIRST FRACTION BIG ENOUGH
143  errtocorr = 1.d0-temp
144  DO i=1,nsicla
145  IF(pro_f(j,k,i)+errtocorr.GT.0.d0.AND.
146  & pro_f(j,k,i)+errtocorr.LE.1.d0 ) THEN
147  pro_f(j,k,i) = pro_f(j,k,i) + errtocorr
148  EXIT
149  ENDIF
150  ENDDO
151  ENDIF
152  ENDIF
153 !-----------------------------------------------------------------------
154 ! RECHECK
155 !-----------------------------------------------------------------------
156  IF(ret .EQV. .false.) THEN
157  ret = cvsp_check_f_gaia(j,k,'ReCheck ')
158  ENDIF
159 !
160 !-----------------------------------------------------------------------
161 !
162  RETURN
163  END FUNCTION cvsp_check_f_gaia
double precision, target dt
Time step It may be different from the one in TELEMAC because of the morphological factor...
subroutine cvsp_p_gaia(PATH_PRE, FILE_PRE, JG)
Definition: cvsp_p_gaia.f:7
integer ncsize
Definition: bief_def.f:49
logical cp
Logical for debug printouts.
integer, target nsicla
Number of sediment classes of bed material (less than NISCLM)
double precision, dimension(:,:,:), allocatable, target pro_f
Vertical sorting profile: fraction for each layer, class, point.
integer, target lt
Numero du pas de temps.
recursive logical function cvsp_check_f_gaia(J, K, SOMETEXT)
integer percou
COUPLING PERIOD USED IN CVSM TO CALCULATE THE TIME, SHOULD COME FROM TELEMAC ONE DAY.
type(bief_mesh), target mesh
Mesh structure.
integer, dimension(:), allocatable pro_max
Maximum layer number in a vertical sorting profile for each point.
Definition: bief.f:3