The TELEMAC-MASCARET system  trunk
calcs2d_biomass.f
Go to the documentation of this file.
1 ! **************************
2  SUBROUTINE calcs2d_biomass
3 ! **************************
4 !
5  & (npoin,wattemp,tn,texp,rayeff,hprop,t1,t2,t3,t4,t5,t6,debug)
6 !
7 !***********************************************************************
8 ! WAQTEL V8P1
9 !***********************************************************************
10 !
11 !brief COMPUTES SOURCE TERMS FOR PHYTOPLANKTONIC BIOMASS WAQ PROCESS
12 !
13 !history R. ATA
14 !+ 21/09/2014
15 !+ V7P0
16 !+ CREATION
17 !
18 !history S.E. BOURBAN (HRW)
19 !+ 07/06/2017
20 !+ V7P3
21 !+ Indexing tracer (IND_*) to avoid conflicting naming convention
22 !+ between user defined tracers, water quality processes and
23 !+ ice processes. Introduction of the array RANK_*.
24 !
25 !history S.E. BOURBAN (HRW)
26 !+ 25/09/2017
27 !+ V7P3
28 !+ TEXP and TIMP are now additive to account for a variety of
29 !+ of sources / sinks on a given TRACER
30 !
31 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
32 !| DEBUG |-->| IF NE.0 THEN DEBUG MODE
33 !| HPROP |-->| WATER DEPTH
34 !| NPOIN |-->| TOTAL NUMBER OF MESH NODES
35 !| RAYEFF |-->| EFFECT OF SUNSHINE ON ALGAE GROWTH
36 !| T1,..,T7 |<--| WORKING STRUCTURES
37 !| TN |-->| TRACER STRUCUTRE
38 !| TEXP |<--| EXPLICIT SOURCE TERMES
39 !| WATTEMP |-->| WATER TEMPERATURE
40 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 !-----------------------------------------------------------------------
42 !***********************************************************************
43  USE bief
46  & cmoralg,trespir,prophoc,dtp,pronitc,k360,k320,pernits,
47  & wpor,wnor,sectoday,kpe,
48  & ind_t,ind_phy,ind_no3,ind_po4,ind_nor,ind_por
49  USE interface_waqtel, ex_calcs2d_biomass => calcs2d_biomass
50 !-----------------------------------------------------------------------
51 ! .___________.____.____.______________________________________________.
52 ! ! NOM !TYPE!MODE! ROLE !
53 ! !___________!____!____!______________________________________________!
54 ! ! WPOR ! R ! ! VITESSE DE SEDIMENTATION DU PHOSPHORE ORGANIQ!
55 ! ! WNOR ! R ! ! VITESSE DE SEDIMENTATION DE L AZOTE ORGANIQUE!
56 ! ! CMAX ! R ! ! TAUX DE CROISSANCE ALGALE MAXIMUM A 20degC !
57 ! ! ZSD ! R ! ! PROFONDEUR DE SECCHI !
58 ! ! KPE ! R ! ! COEF DE TURBIDITE VEGETALE !
59 ! ! IK ! R ! ! PARAMETRE DE CALAGE DE LA FORMULE DE SMITH !
60 ! ! KP ! R ! ! CONSTANTE DE DEMI-SATURATION EN PHOSPHATE !
61 ! ! KN ! R ! ! CONSTANTE DE DEMI-SATURATION EN AZOTE !
62 ! ! ALPHA ! R ! ! COEF 1 DE TOXICITE DE L EAU POUR LES ALGUES !
63 ! ! ALPHA2 ! R ! ! COEF 2 DE TOXICITE DE L EAU POUR LES ALGUES !
64 ! ! RP ! R ! ! TAUX DE RESP. DE LA BIOMASSE ALGALE A 20° C !
65 ! ! PROPHOC ! R ! ! PROP DE PHOSPHORE DANS LES CELLULES DU PHYTO !
66 ! ! DTP ! R ! ! POURCENT DE PHOSPH DIRECT ASSIM DS PHY MORT !
67 ! ! K320 ! R ! ! TAUX DE TRANSFORMATION DU POR EN PO4 !
68 ! ! PRONITC ! R ! ! PROP D AZOTE DANS LES CELLULES DU PHYTO !
69 ! ! PERNITS ! R ! ! POURCENT D AZOTE DIRECT ASSIM DS PHY MORT !
70 ! ! K360 ! R ! ! TAUX DE TRANSFORMATION DU NOR EN NO3 !
71 ! ! M1 ! R ! ! COEF 1 DE MORTALITE ALGALE A 20° C !
72 ! ! M2 ! R ! ! COEF 2 DE MORTALITE ALGALE A 20° C !
73 ! ! ! ! ! !
74 ! ! IF1 ! TR ! D ! INDIC DE LECTURE DU FICHIER DES PARAMETRES !
75 ! !___________!____!____!______________________________________________!
76 ! MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
77 ! (ENTREE) (SORTIE) (ENTREE/SORTIE)
78 !-----------------------------------------------------------------------
79 !***********************************************************************
81  IMPLICIT NONE
82 !
83 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
84 !
85  INTEGER , INTENT(IN ) :: npoin,debug
86  DOUBLE PRECISION , INTENT(IN ) :: wattemp
87  TYPE(bief_obj) , INTENT(IN ) :: tn,hprop
88  TYPE(bief_obj) , INTENT(INOUT) :: texp,rayeff,t1,t2,t3,t4,t5,t6
89 !
90 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
91 !
92 !
93 ! LOCAL VARIABLES
94  DOUBLE PRECISION, PARAMETER :: eps=1.d-3
95  DOUBLE PRECISION, PARAMETER :: unsurvingt=0.05d0
96  DOUBLE PRECISION :: g1
97 !
98  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 0'
99 !
100 !-----------------------------------------------------------------------
101 !
102 ! INITIALISATION
103 !
104 ! CP IS STORED IN T3
105  CALL os( 'X=0 ',x=t3)
106 ! DP IS STORED IN T4
107  CALL os( 'X=0 ',x=t4)
108 ! LNUT IS STORED IN T5
109  CALL os( 'X=0 ',x=t5)
110 !
111 ! G1 IS STOCKED IN T6, WE TAKE INTO ACCOUNT VARIABLE TEMPERATURE
112 !
113  g1 = wattemp/20.d0
114  IF( ind_t.GT.0 )THEN
115  CALL os('X=CY ',x=t6,y=tn%ADR(ind_t)%P,c=unsurvingt)
116  ELSE
117  CALL os('X=C ',x=t6,c=g1)
118  ENDIF
119 !
120  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 1'
121 !
122 ! RAYEFF WITH SMITH FORMULA
123 !
124  CALL ray_effect(zsd,tn%ADR(ind_phy)%P,npoin,mextinc,i0,ik,kpe,
125  & rayeff,hprop,t1,t2)
126 !
127  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 2'
128 !
129 ! COMPUTE LNUT
130 !
131  CALL nuteff(t5%R,tn,npoin,ind_po4,ind_no3,kp,kn)
132 !
133  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 3'
134 !
135 ! RATE OF ALGAE GROWTH
136 !
137  CALL algae_growth(t3%R,cmax,rayeff%R,t6,t5%R,ctoxic(1),npoin)
138 !
139  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 4'
140 !
141 ! RATE OF ALGAE DISAPPEARANCE
142 !
143  CALL algae_death(t4%R,t1%R,cmoralg,tn%ADR(ind_phy)%P%R,trespir,t6,
144  & ctoxic(2),npoin)
145 !
146  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 5'
147 !
148 !-----------------------------------------------------------------------
149 !
150 ! LET'S NOW COMPUTE SOURCE TERMS
151 !
152 ! FIRST TRACER [PHY] (IND_PHY)
153 !
154  CALL os( 'X=Y-Z ' ,x=t1 ,y=t3,z=t4)
155 ! CALL OS( 'X=YZ ' ,X=TEXP%ADR(IND_PHY)%P,Y=T1,
156 ! & Z=TN%ADR(IND_PHY)%P)
157  CALL os( 'X=X+CYZ ' ,x=texp%ADR(ind_phy)%P,y=t1,
158  & z=tn%ADR(ind_phy)%P,c=sectoday)
159 !
160  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 6'
161 !
162 ! SECOND TRACER [PO4] (IND_PO4)
163 !
164  CALL os( 'X=CY ' ,x=t1,y=t4 ,c=dtp )
165  CALL os( 'X=X-Y ' ,x=t1,y=t3 )
166  CALL os( 'X=CXY ' ,x=t1,y=tn%ADR(ind_phy)%P ,c=prophoc )
167  CALL os( 'X=CYZ ' ,x=t2,y=tn%ADR(ind_por)%P,z=t6,c=k320 )
168 !
169 ! CALL OS( 'X=Y+Z ' ,X=TEXP%ADR(IND_PO4)%P,Y=T1,Z=T2 )
170  CALL os( 'X=X+Y ' ,x=t1,y=t2 )
171  CALL os( 'X=X+CY ' ,x=texp%ADR(ind_po4)%P,y=t1 ,c=sectoday )
172 !
173  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 7'
174 !
175 ! THIRD TRACER [POR] (IND_POR)
176 !
177  g1=prophoc*(1.d0-dtp)
178  CALL os( 'X=CYZ ' ,x=t1,y=t4,z=tn%ADR(ind_phy)%P,c=g1 )
179  CALL os( 'X=X-Y ' ,x=t1,y=t2 )
180  CALL ovd('X=CY/Z ' ,t2%R,tn%ADR(ind_por)%P%R,hprop%R,wpor,
181  & npoin ,2,0.d0,eps )
182 ! CALL OS( 'X=Y-Z ' ,X=TEXP%ADR(IND_POR)%P,Y=T1,Z=T2 )
183  CALL os( 'X=X-Y ' ,x=t1,y=t2 )
184  CALL os( 'X=X+CY ' ,x=texp%ADR(ind_por)%P,y=t1 ,c=sectoday )
185 !
186  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 8'
187 !
188 ! FOURTH TRACER [NO3] (IND_NO3)
189 !
190  CALL os( 'X=CY ' ,x=t1,y=t4 ,c=pernits)
191  CALL os( 'X=C(Y-Z)' ,x=t1,y=t1 ,z=t3,c=pronitc)
192  CALL os( 'X=XY ' ,x=t1,y=tn%ADR(ind_phy)%P )
193  CALL os( 'X=CYZ ' ,x=t2,y=tn%ADR(ind_nor)%P ,z=t6,c=k360 )
194 !
195 ! CALL OS( 'X=Y+Z ' ,X=TEXP%ADR(IND_NO3)%P,Y=T1,Z=T2 )
196  CALL os( 'X=X+Y ' ,x=t1,y=t2 )
197  CALL os( 'X=X+CY ' ,x=texp%ADR(ind_no3)%P,y=t1 ,c=sectoday )
198 !
199  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 9'
200 !
201 ! FIFTH TRACER [NOR] (IND_NOR)
202 !
203  g1=pronitc*(1.d0-pernits)
204  CALL os( 'X=CYZ ' ,x=t1,y=t4,z=tn%ADR(ind_phy)%P,c=g1 )
205  CALL os( 'X=X-Y ' ,x=t1,y=t2 )
206  CALL ovd('X=CY/Z ' ,t2%R,tn%ADR(ind_nor)%P%R,hprop%R,wnor,
207  & npoin ,2,0.d0,eps )
208 !
209 ! CALL OS( 'X=Y-Z ' ,X=TEXP%ADR(IND_NOR)%P,Y=T1,Z=T2 )
210  CALL os( 'X=X-Y ' ,x=t1,y=t2 )
211  CALL os( 'X=X+CY ' ,x=texp%ADR(ind_nor)%P,y=t1 ,c=sectoday )
212 !
213  IF(debug.GT.0)WRITE(lu,*)'IN BIOMASS, STEP 10'
214 !
215 !-----------------------------------------------------------------------
216 !
217  RETURN
218  END
double precision, dimension(2) ctoxic
subroutine ray_effect(SECCHI, TRR, NPOIN, MEXT, I0, IK, KPE, EFF, H, T1, T2)
Definition: ray_effect.f:7
subroutine nuteff(LNUT, TRR, NPOIN, IPO4, INO3, KP, KN)
Definition: nuteff.f:7
subroutine ovd(OP, X, Y, Z, C, NPOIN, IOPT, D, EPS)
Definition: ovd.f:7
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3