The TELEMAC-MASCARET system  trunk
calcs2d_degradation.f
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE calcs2d_degradation
3 ! ******************************
4 !
5  &(npoin,tn,texp,timp,hprop,nwaq_degra,rank_degra,loitrac,
6  & coef1trac)
7 !
8 !***********************************************************************
9 ! WAQTEL V8P2
10 !***********************************************************************
11 !
12 !brief COMPUTES SOURCE TERMS FOR DEGRADATION LAWS PROCESSES
13 !
14 !history C.-T. PHAM
15 !+ 26/07/2020
16 !+ V8P2
17 !+ Creation from SOURCE_WAQ
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20 !| COEF1TRAC |-->| COEFFICIENT 1 FOR LAW OF TRACERS DEGRADATION
21 !| HPROP |-->| PROPAGATION DEPTH
22 !| LOITRAC |-->| LAW OF TRACERS DEGRADATION
23 !| NPOIN |-->| NUMBER OF NODES IN THE MESH
24 !| NWAQ_DEGRA |-->| NUMBER OF TRACERS WITH A DEGRADATION LAW
25 !| RANK_DEGRA |-->| GROUP TRACERS WITH A DEGRADATION LAW
26 !| TEXP |-->| EXPLICIT SOURCE TERM
27 !| TIMP |-->| IMPLICIT SOURCE TERM
28 !| TN |-->| TRACERS AT TIME N
29 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30 !
31  USE bief
33  IMPLICIT NONE
34 !
35 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
36 !
37  INTEGER, INTENT(IN) :: npoin
38  TYPE(bief_obj), INTENT(IN) :: tn
39  TYPE(bief_obj), INTENT(INOUT) :: texp,timp
40  TYPE(bief_obj), INTENT(IN) :: hprop
41  INTEGER, INTENT(IN) :: nwaq_degra
42  INTEGER, INTENT(IN) :: loitrac(*)
43  INTEGER, INTENT(IN) :: rank_degra(*)
44  DOUBLE PRECISION, INTENT(IN) :: coef1trac(*)
45 !
46 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
47 !
48  INTEGER j,itrac
49 !
50 !-----------------------------------------------------------------------
51 !
52  DO j = 1,nwaq_degra
53  itrac = rank_degra(j)
54  IF(loitrac(itrac).EQ.1) THEN
55  CALL os('X=X+CY ',x=timp%ADR(itrac)%P,
56  & y=hprop,c=-2.3d0/coef1trac(itrac)/3600.d0)
57  ELSEIF(loitrac(itrac).EQ.2) THEN
58  CALL os('X=X+CY ',x=timp%ADR(itrac)%P,
59  & y=hprop,c=-coef1trac(itrac)/3600.d0)
60  ELSEIF(loitrac(itrac).EQ.3) THEN
61  CALL os('X=X+CY ',x=timp%ADR(itrac)%P,
62  & y=hprop,c=-coef1trac(itrac)/86400.d0)
63  ELSEIF(loitrac(itrac).EQ.4) THEN
64  CALL user_calcs2d_degradation(npoin,tn,texp,timp,hprop,
65  & nwaq_degra,rank_degra,loitrac,coef1trac)
66  ELSEIF(loitrac(itrac).GT.4) THEN
67  WRITE(lu,21) loitrac(itrac),itrac
68 21 FORMAT(1x,'LOITRAC ',i4,' FOR TRACER ',i4,' NOT IMPLEMENTED YET')
69  CALL plante(1)
70  stop
71  ENDIF
72 !
73  ENDDO
74 !
75 !-----------------------------------------------------------------------
76 !
77  RETURN
78  END
subroutine user_calcs2d_degradation(NPOIN, TN, TEXP, TIMP, HPROP, NWAQ_DEGRA, RANK_DEGRA, LOITRAC, COEF1TRAC)
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3