The TELEMAC-MASCARET system  trunk
calcs3d_degradation.f
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE calcs3d_degradation
3 ! ******************************
4 !
5  &(npoin3,npoin2,nplan,tn,texp,timp,z,nwaq_degra,rank_degra,
6  & loitrac,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 !| LOITRAC |-->| LAW OF TRACERS DEGRADATION
22 !| NPLAN |-->| NUMBER OF VERTICAL PLANES
23 !| NPOIN2 |-->| NUMBER OF NODES IN THE 2D MESH
24 !| NPOIN3 |-->| NUMBER OF NODES IN THE 3D MESH
25 !| NWAQ_DEGRA |-->| NUMBER OF TRACERS WITH A DEGRADATION LAW
26 !| RANK_DEGRA |-->| GROUP TRACERS WITH A DEGRADATION LAW
27 !| TEXP |-->| EXPLICIT SOURCE TERM
28 !| TIMP |-->| IMPLICIT SOURCE TERM
29 !| TN |-->| TRACERS AT TIME N
30 !| Z |-->| Z COORDINATES FOR NODES
31 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
32 !
33  USE bief
35  IMPLICIT NONE
36 !
37 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
38 !
39  INTEGER, INTENT(IN) :: npoin3,npoin2,nplan
40  TYPE(bief_obj), INTENT(IN) :: tn
41  TYPE(bief_obj), INTENT(INOUT) :: texp,timp
42  TYPE(bief_obj), INTENT(IN) :: z
43  INTEGER, INTENT(IN) :: nwaq_degra
44  INTEGER, INTENT(IN) :: loitrac(*)
45  INTEGER, INTENT(IN) :: rank_degra(*)
46  DOUBLE PRECISION, INTENT(IN) :: coef1trac(*)
47 !
48 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
49 !
50  INTEGER j,itrac
51 !
52 !-----------------------------------------------------------------------
53 !
54  DO j = 1,nwaq_degra
55  itrac = rank_degra(j)
56  IF(loitrac(itrac).EQ.1) THEN
57  CALL os('X=X+C ',x=timp%ADR(itrac)%P,
58  & c=2.3d0/coef1trac(itrac)/3600.d0)
59  ELSEIF(loitrac(itrac).EQ.2) THEN
60  CALL os('X=X+C ',x=timp%ADR(itrac)%P,
61  & c=coef1trac(itrac)/3600.d0)
62  ELSEIF(loitrac(itrac).EQ.3) THEN
63  CALL os('X=X+C ',x=timp%ADR(itrac)%P,
64  & c=coef1trac(itrac)/86400.d0)
65  ELSEIF(loitrac(itrac).EQ.4) THEN
66  CALL user_calcs3d_degradation(npoin3,npoin2,nplan,tn,texp,
67  & timp,z,nwaq_degra,rank_degra,loitrac,
68  & coef1trac)
69  ELSEIF(loitrac(itrac).GT.4) THEN
70  WRITE(lu,21) loitrac(itrac),itrac
71 21 FORMAT(1x,'LOITRAC ',i4,' FOR TRACER ',i4,' NOT IMPLEMENTED YET')
72  CALL plante(1)
73  stop
74  ENDIF
75 !
76  ENDDO
77 !
78 !-----------------------------------------------------------------------
79 !
80  RETURN
81  END
subroutine user_calcs3d_degradation(NPOIN3, NPOIN2, NPLAN, TN, TEXP, TIMP, Z, NWAQ_DEGRA, RANK_DEGRA, LOITRAC, COEF1TRAC)
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3