/[MITgcm]/MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F
ViewVC logotype

Contents of /MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.13 - (show annotations) (download)
Tue Oct 23 16:39:32 2012 UTC (12 years, 9 months ago) by stephd
Branch: MAIN
Changes since 1.12: +58 -1 lines
o add diagnostics for chl:c, Ek and Ek/E

1 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F,v 1.12 2012/08/24 19:45:36 jahn Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5 #include "PTRACERS_OPTIONS.h"
6 #include "DARWIN_OPTIONS.h"
7
8 #ifdef ALLOW_PTRACERS
9 #ifdef ALLOW_MONOD
10
11 c=============================================================
12 c subroutine MONOD_forcing
13 c step forward bio-chemical tracers in time
14 C==============================================================
15 SUBROUTINE MONOD_FORCING(
16 U Ptr,
17 I bi,bj,imin,imax,jmin,jmax,
18 I myTime,myIter,myThid)
19 #include "SIZE.h"
20 #include "EEPARAMS.h"
21 #include "PARAMS.h"
22 #include "GRID.h"
23 #include "DYNVARS.h"
24 c for Qsw and/or surfaceForcingT
25 c choice which field to take pCO2 from for pCO2limit
26 c this assumes we use Ttendency from offline
27 #include "FFIELDS.h"
28 #ifdef ALLOW_LONGSTEP
29 #include "LONGSTEP.h"
30 #endif
31 #include "PTRACERS_SIZE.h"
32 #include "PTRACERS_PARAMS.h"
33 #include "GCHEM.h"
34 #include "MONOD_SIZE.h"
35 #include "MONOD.h"
36 #include "DARWIN_IO.h"
37 #include "DARWIN_FLUX.h"
38 #include "MONOD_FIELDS.h"
39
40 c ANNA include wavebands_params.h
41 #ifdef WAVEBANDS
42 #include "SPECTRAL_SIZE.h"
43 #include "SPECTRAL.h"
44 #include "WAVEBANDS_PARAMS.h"
45 #endif
46
47
48 C === Global variables ===
49 c tracers
50 _RL Ptr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy,nDarwin)
51 INTEGER bi,bj,imin,imax,jmin,jmax
52 INTEGER myIter
53 _RL myTime
54 INTEGER myThid
55
56 C !FUNCTIONS:
57 C == Functions ==
58 #ifdef ALLOW_PAR_DAY
59 LOGICAL DIFF_PHASE_MULTIPLE
60 EXTERNAL DIFF_PHASE_MULTIPLE
61 #endif
62
63 C============== Local variables ============================================
64 c plankton arrays
65 _RL ZooP(nzmax)
66 _RL ZooN(nzmax)
67 _RL ZooFe(nzmax)
68 _RL ZooSi(nzmax)
69 _RL Phy(npmax)
70 _RL Phy_k(npmax,Nr)
71 _RL Phyup(npmax)
72 _RL part_k(Nr)
73 #ifdef ALLOW_CDOM
74 _RL cdom_k(Nr)
75 #endif
76 c iron partitioning
77 _RL freefe(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
78 c some working variables
79 _RL sumpy
80 _RL sumpyup
81 c light variables
82 _RL PAR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
83 _RL sfac(1-OLy:sNy+OLy)
84 _RL atten,lite
85 _RL newtime ! for sub-timestepping
86 _RL runtim ! time from tracer initialization
87
88
89 c ANNA define variables for wavebands
90 #ifdef WAVEBANDS
91 integer ilam
92 _RL PARw_k(tlam,Nr)
93 _RL PARwup(tlam)
94 _RL acdom_k(Nr,tlam)
95 _RL Ek_nll(npmax,tlam)
96 _RL EkoverE_nll(npmax,tlam)
97 #ifdef DAR_RADTRANS
98 integer iday,iyr,imon,isec,lp,wd,mydate(4)
99 _RL Edwsf(tlam),Eswsf(tlam)
100 _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr)
101 _RL Estop(tlam,Nr),Eutop(tlam,Nr)
102 _RL tirrq(nr)
103 _RL tirrwq(tlam,nr)
104 _RL amp1(tlam,nr), amp2(tlam,nr)
105 _RL solz
106 _RL rmud
107 _RL actot,bctot,bbctot
108 _RL apart_k(Nr,tlam),bpart_k(Nr,tlam),bbpart_k(Nr,tlam)
109 _RL bt_k(Nr,tlam), bb_k(Nr,tlam)
110 _RL discEs, discEu
111 INTEGER idiscEs,jdiscEs,kdiscEs,ldiscEs
112 INTEGER idiscEu,jdiscEu,kdiscEu,ldiscEu
113 #else
114 _RL PARwdn(tlam)
115 #endif
116 C always need for diagnostics
117 _RL a_k(Nr,tlam)
118 #endif /* WAVEBANDS */
119
120
121 #ifdef DAR_DIAG_DIVER
122 _RL Diver1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
123 _RL Diver2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
124 _RL Diver3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
125 _RL Diver4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
126 _RL Shannon(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
127 _RL Simpson(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
128
129 _RL tmpphy(npmax)
130 _RL totphy, biotot, maxphy, phymax
131 #endif
132
133 #ifdef GEIDER
134 _RL phychl(npmax)
135 _RL phychl_k(npmax,Nr)
136 _RL Ekl(npmax)
137 _RL EkoverEl(npmax)
138 _RL chl2cl(npmax)
139 #ifdef DYNAMIC_CHL
140 _RL dphychl(npmax)
141 _RL chlup(npmax)
142 _RL accliml(npmax)
143 #endif
144 #endif
145 #ifdef ALLOW_CDOM
146 _RL cdoml
147 _RL dcdoml
148 #endif
149
150 #ifdef ALLOW_DIAGNOSTICS
151 COJ for diagnostics
152 _RL PParr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
153 _RL Nfixarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
154 c ANNA_TAVE
155 #ifdef WAVES_DIAG_PCHL
156 _RL Pchlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
157 #endif
158 c ANNA end TAVE
159 #ifdef DAR_DIAG_RSTAR
160 _RL Rstararr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
161 #endif
162 #ifdef ALLOW_DIAZ
163 #ifdef DAR_DIAG_NFIXP
164 _RL NfixParr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
165 #endif
166 #endif
167 #endif
168
169
170 _RL totphyC
171 #ifdef ALLOW_PAR_DAY
172 LOGICAL itistime
173 INTEGER PARiprev, PARiaccum, iperiod, nav
174 _RL phase
175 _RL dtsubtime
176 #endif
177 #ifdef DAR_DIAG_CHL
178 _RL ChlGeiderlocal, ChlDoneylocal, ChlCloernlocal
179 #ifdef ALLOW_DIAGNOSTICS
180 _RL GeiderChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
181 _RL GeiderChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
182 _RL DoneyChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
183 _RL DoneyChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
184 _RL CloernChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
185 _RL CloernChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
186 #endif
187 #endif
188 c
189 _RL freefu
190 _RL inputFel
191
192 c some local variables
193 _RL PO4l
194 _RL NO3l
195 _RL FeTl
196 _RL Sil
197 _RL DOPl
198 _RL DONl
199 _RL DOFel
200 _RL POPl
201 _RL PONl
202 _RL POFel
203 _RL PSil
204 _RL POPupl
205 _RL PONupl
206 _RL POFeupl
207 _RL PSiupl
208 _RL Tlocal
209 _RL Slocal
210 _RL pCO2local
211 _RL Qswlocal
212 _RL NH4l
213 _RL NO2l
214 _RL PARl
215 _RL dzlocal
216 _RL dz_k(Nr)
217 _RL dtplankton
218 _RL bottom
219 _RL PP
220 _RL Nfix
221 _RL denit
222 _RL Chl
223 _RL Rstarl(npmax)
224 _RL RNstarl(npmax)
225 #ifdef DAR_DIAG_GROW
226 _RL Growl(npmax)
227 _RL Growsql(npmax)
228 #endif
229 #ifdef ALLOW_DIAZ
230 #ifdef DAR_DIAG_NFIXP
231 _RL NfixPl(npmax)
232 #endif
233 #endif
234
235 c local tendencies
236 _RL dphy(npmax)
237 _RL dzoop(nzmax)
238 _RL dzoon(nzmax)
239 _RL dzoofe(nzmax)
240 _RL dzoosi(nzmax)
241 _RL dPO4l
242 _RL dNO3l
243 _RL dFeTl
244 _RL dSil
245 _RL dDOPl
246 _RL dDONl
247 _RL dDOFel
248 _RL dPOPl
249 _RL dPONl
250 _RL dPOFel
251 _RL dPSil
252 _RL dNH4l
253 _RL dNO2l
254
255 #ifdef ALLOW_CARBON
256 _RL dicl
257 _RL docl
258 _RL pocl
259 _RL picl
260 _RL alkl
261 _RL o2l
262 _RL ZooCl(nzmax)
263 _RL pocupl
264 _RL picupl
265 c tendencies
266 _RL ddicl
267 _RL ddocl
268 _RL dpocl
269 _RL dpicl
270 _RL dalkl
271 _RL do2l
272 _RL dZooCl(nzmax)
273 c air-sea fluxes
274 _RL flxCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
275 _RL flxALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
276 _RL flxO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
277 #endif
278
279 _RL tot_Nfix
280
281 _RL tmp
282
283 _RL phytmp, chltmp
284
285 INTEGER i,j,k,it, ktmp
286 INTEGER np, nz, np2, npsave
287 INTEGER debug
288 CHARACTER*8 diagname
289
290 c
291 c
292 c
293 DO j=1-OLy,sNy+OLy
294 DO i=1-OLx,sNx+OLx
295 do k=1,Nr
296 freefe(i,j,k)=0. _d 0
297 PAR(i,j,k) = 0. _d 0
298 #ifdef DAR_DIAG_DIVER
299 Diver1(i,j,k)=0. _d 0
300 Diver2(i,j,k)=0. _d 0
301 Diver3(i,j,k)=0. _d 0
302 Diver4(i,j,k)=0. _d 0
303 Shannon(i,j,k)=0. _d 0
304 Simpson(i,j,k)=1. _d 0
305 #endif
306
307 #ifdef ALLOW_DIAGNOSTICS
308 COJ for diagnostics
309 PParr(i,j,k) = 0. _d 0
310 Nfixarr(i,j,k) = 0. _d 0
311 #ifdef DAR_DIAG_CHL
312 GeiderChlarr(i,j,k) = 0. _d 0
313 GeiderChl2Carr(i,j,k) = 0. _d 0
314 DoneyChlarr(i,j,k) = 0. _d 0
315 DoneyChl2Carr(i,j,k) = 0. _d 0
316 CloernChlarr(i,j,k) = 0. _d 0
317 CloernChl2Carr(i,j,k) = 0. _d 0
318 #endif
319 c ANNA_TAVE
320 #ifdef WAVES_DIAG_PCHL
321 DO np=1,npmax
322 Pchlarr(i,j,k,np) = 0. _d 0
323 ENDDO
324 #endif
325 c ANNA end TAVE
326 #ifdef DAR_DIAG_RSTAR
327 DO np=1,npmax
328 Rstararr(i,j,k,np) = 0. _d 0
329 ENDDO
330 #endif
331 COJ
332 #ifdef ALLOW_DIAZ
333 #ifdef DAR_DIAG_NFIXP
334 DO np=1,npmax
335 NfixParr(i,j,k,np) = 0. _d 0
336 ENDDO
337 #endif
338 #endif
339 #endif
340 enddo
341 ENDDO
342 ENDDO
343
344 #ifdef DAR_RADTRANS
345 idiscEs = 0
346 jdiscEs = 0
347 kdiscEs = 0
348 ldiscEs = 0
349 idiscEu = 0
350 jdiscEu = 0
351 kdiscEu = 0
352 ldiscEu = 0
353 discEs = 0.
354 discEu = 0.
355 #endif
356 c
357 c bio-chemical time loop
358 c--------------------------------------------------
359 DO it=1,nsubtime
360 c -------------------------------------------------
361 tot_Nfix=0. _d 0
362 COJ cannot use dfloat because of adjoint
363 COJ division will be double precision anyway because of dTtracerLev
364 newtime=myTime-dTtracerLev(1)+
365 & float(it)*dTtracerLev(1)/float(nsubtime)
366 c print*,'it ',it,newtime,nsubtime,myTime
367 runtim=myTime-float(PTRACERS_Iter0)*dTtracerLev(1)
368
369 c determine iron partitioning - solve for free iron
370 c ---------------------------
371 call darwin_fe_chem(bi,bj,iMin,iMax,jMin,jMax,
372 & Ptr(1-OLx,1-OLy,1,bi,bj,iFeT), freefe,
373 & myIter, mythid)
374 c --------------------------
375 #ifdef ALLOW_CARBON
376 c air-sea flux and dilution of CO2
377 call dic_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
378 & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
379 & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
380 & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
381 & flxCO2,
382 & bi,bj,imin,imax,jmin,jmax,
383 & myIter,myTime,myThid)
384 c air-sea flux of O2
385 call dic_o2_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iO2),
386 & flxO2,
387 & bi,bj,imin,imax,jmin,jmax,
388 & myIter,myTime,myThid)
389 c dilusion of alkalinity
390 call dic_alk_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
391 & flxALK,
392 & bi,bj,imin,imax,jmin,jmax,
393 & myIter,myTime,myThid)
394 #endif
395
396
397 c find light in each grid cell
398 c ---------------------------
399 c determine incident light
400 #ifndef READ_PAR
401 #ifndef USE_QSW
402 DO j=1-OLy,sNy+OLy
403 sfac(j)=0. _d 0
404 ENDDO
405 call darwin_insol(newTime,sfac,bj)
406 #endif /* not USE_QSW */
407 #endif /* not READ_PAR */
408
409 #ifdef ALLOW_PAR_DAY
410 C find out which slot of PARday has previous day's average
411 dtsubtime = dTtracerLev(1)/float(nsubtime)
412 C running index of averaging period
413 C myTime has already been incremented in this iteration,
414 C go back half a substep to avoid roundoff problems
415 iperiod = FLOOR((newtime-0.5 _d 0*dtsubtime)
416 & /darwin_PARavPeriod)
417 C 0 -> 1, 1->2, 2->0, ...
418 PARiprev = MOD(iperiod, 2) + 1
419
420 #ifdef ALLOW_DIAGNOSTICS
421 C always fill; this will be the same during PARavPeriod, but this
422 C way it won't blow up for weird diagnostics periods.
423 C we fill before updating, so the diag is the one used in this time
424 C step
425 CALL DIAGNOSTICS_FILL(
426 & PARday(1-Olx,1-Oly,1,bi,bj,PARiprev),'PARday ',
427 & 0,Nr,2,bi,bj,myThid )
428 #endif
429 #endif /* ALLOW_PAR_DAY */
430
431 #ifdef DAR_RADTRANS
432 #ifndef DAR_RADTRANS_USE_MODEL_CALENDAR
433 #ifdef ALLOW_CAL
434 C get current date and time of day: iyr/imon/iday+isec
435 CALL CAL_GETDATE( myIter, newtime, mydate, mythid )
436 CALL CAL_CONVDATE( mydate,iyr,imon,iday,isec,lp,wd,mythid )
437 #else
438 STOP 'need cal package or DAR_RADTRANS_USE_MODEL_CALENDAR'
439 #endif
440 #endif
441 #endif
442
443 C.................................................................
444 C.................................................................
445
446
447 C ========================== i,j loops =================================
448 DO j=1,sNy
449 DO i=1,sNx
450
451 c ------------ these are convenient ------------------------------------
452 DO k=1,Nr
453 part_k(k) = max(Ptr(i,j,k,bi,bj,iPOP),0. _d 0)
454 #ifdef ALLOW_CDOM
455 cdom_k(k) = max(Ptr(i,j,k,bi,bj,iCDOM),0. _d 0)
456 #endif
457 DO np = 1,npmax
458 Phy_k(np,k) = max(Ptr(i,j,k,bi,bj,iPhy+np-1),0. _d 0)
459 #ifdef GEIDER
460 #ifdef DYNAMIC_CHL
461 phychl_k(np,k) = max(Ptr(i,j,k,bi,bj,iChl+np-1),0. _d 0)
462 #else
463 phychl_k(np,k) = max(Chl_phy(i,j,k,bi,bj,np), 0. _d 0)
464 #endif
465 #endif
466 ENDDO
467 ENDDO
468
469 c ------------ GET CDOM_k FOR WAVEBANDS_3D and RADTRANS ----------------
470 #ifdef WAVEBANDS
471 #if defined(DAR_CALC_ACDOM) || defined(DAR_RADTRANS)
472 #ifdef ALLOW_CDOM
473 call MONOD_ACDOM(cdom_k,
474 O acdom_k,
475 I myThid)
476 #else
477 call MONOD_ACDOM(phychl_k,aphy_chl,aw,
478 O acdom_k,
479 I myThid)
480 #endif
481 #else
482 DO k=1,Nr
483 DO ilam = 1,tlam
484 acdom_k(k,ilam) = acdom(ilam)
485 ENDDO
486 ENDDO
487 #endif /* DAR_CALC_ACDOM or DAR_RADTRANS */
488 #endif /* WAVEBANDS */
489
490 c ------------ GET INCIDENT NON-SPECTRAL LIGHT -------------------------
491 #if !(defined(WAVEBANDS) && defined(OASIM))
492 #ifdef READ_PAR
493
494 lite = sur_par(i,j,bi,bj)
495
496 #else /* not READ_PAR */
497 #ifdef USE_QSW
498
499 #ifdef ALLOW_LONGSTEP
500 Qswlocal=LS_Qsw(i,j,bi,bj)
501 #else
502 Qswlocal=Qsw(i,j,bi,bj)
503 #endif
504 lite = -parfrac*Qswlocal*parconv*maskC(i,j,1,bi,bj)
505
506 #else /* not USE_QSW */
507
508 lite = sfac(j)*maskC(i,j,1,bi,bj)/86400*1 _d 6
509
510 #endif /* not USE_QSW */
511 #endif /* not READ_PAR */
512
513 c take ice coverage into account
514 c unless already done in seaice package
515 #if !(defined (ALLOW_SEAICE) && defined (USE_QSW))
516 lite = lite*(1. _d 0-fice(i,j,bi,bj))
517 #endif
518 #endif /* not(WAVEBANDS and OASIM) */
519
520 c ------------ LIGHT ATTENUATION: --------------------------------------
521 #ifndef WAVEBANDS
522 c ------------ SINGLE-BAND ATTENUATION ---------------------------------
523 atten=0. _d 0
524 do k=1,Nr
525 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
526 sumpyup = sumpy
527 sumpy = 0. _d 0
528 do np=1,npmax
529 #ifdef GEIDER
530 sumpy = sumpy + phychl_k(np,k)
531 #else
532 sumpy = sumpy + Phy_k(np,k)
533 #endif
534 enddo
535 atten= atten + (k0 + kc*sumpy)*5. _d -1*drF(k)
536 if (k.gt.1)then
537 atten = atten + (k0+kc*sumpyup)*5. _d -1*drF(k-1)
538 endif
539 PAR(i,j,k) = lite*exp(-atten)
540 endif
541 enddo
542
543 #else /* WAVEBANDS */
544 #ifndef DAR_RADTRANS
545 c ------------ WAVEBANDS W/O RADTRANS ----------------------------------
546 do ilam = 1,tlam
547 #ifdef OASIM
548 c add direct and diffuse, convert to uEin/m2/s/nm
549 PARwup(ilam) = WtouEins(ilam)*(oasim_ed(i,j,ilam,bi,bj)+
550 & oasim_es(i,j,ilam,bi,bj))
551 c and take ice fraction into account
552 c PARwup(ilam) = PARwup(ilam)*(1 _d 0 - fice(i,j,bi,bj))
553 #else
554 c sf is per nm; convert to per waveband
555 PARwup(ilam) = wb_width(ilam)*sf(ilam)*lite
556 #endif
557 enddo
558
559 do k=1,Nr
560 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
561 do ilam = 1,tlam
562 sumpy = 0.
563 do np = 1,npmax
564 c get total attenuation (absorption) by phyto at each wavelength
565 sumpy = sumpy + (phychl_k(np,k)*aphy_chl(np,ilam))
566 enddo
567 c for diagnostic
568 a_k(k,ilam) = aw(ilam) + sumpy + acdom_k(k,ilam)
569 atten = a_k(k,ilam)*drF(k)
570 PARwdn(ilam) = PARwup(ilam)*exp(-atten)
571 enddo
572
573 c find for the midpoint of the gridcell (gridcell mean)
574 do ilam = 1,tlam
575 C PARw_k(ilam,k)=exp((log(PARwup(ilam))+log(PARwdn(ilam)))*0.5)
576 PARw_k(ilam,k)=sqrt(PARwup(ilam)*PARwdn(ilam))
577 enddo
578
579 c cycle
580 do ilam=1,tlam
581 PARwup(ilam) = PARwdn(ilam)
582 enddo
583 else
584 do ilam=1,tlam
585 PARw_k(ilam,k) = 0. _d 0
586 enddo
587 endif
588
589 c sum wavebands for total PAR at the mid point of the gridcell (PARl)
590 PAR(i,j,k) = 0.
591 do ilam = 1,tlam
592 PAR(i,j,k) = PAR(i,j,k) + PARw_k(ilam,k)
593 enddo
594 enddo
595
596 #else /* DAR_RADTRANS */
597 c ------------ FULL RADIATIVE TRANSFER CODE ----------------------------
598 do ilam = 1,tlam
599 Edwsf(ilam) = oasim_ed(i,j,ilam,bi,bj)
600 Eswsf(ilam) = oasim_es(i,j,ilam,bi,bj)
601 enddo
602
603 #ifdef DAR_RADTRANS_USE_MODEL_CALENDAR
604 C simplified solar zenith angle for 360-day year and daily averaged light
605 C cos(solz) is average over daylight period
606 call darwin_solz360(newtime, YC(i,j,bi,bj),
607 O solz)
608
609 #else /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
610 C use calendar date for full solar zenith angle computation
611 C oj: average light effective at noon?
612 solz = 0.0 _d 0
613 isec = 12*3600
614 call radtrans_sfcsolz(rad,iyr,imon,iday,isec,
615 I XC(i,j,bi,bj),YC(i,j,bi,bj),
616 O solz)
617 #endif /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
618
619 c have Ed,Es below surface - no need for this adjustment on Ed Es for surface affects
620 c do ilam=1,tlam
621 c rod(ilam) = 0.0 _d 0
622 c ros(ilam) = 0.0 _d 0
623 c enddo
624
625 c compute 1/cos(zenith) for direct light below surface
626 call radtrans_sfcrmud(rad,solz,
627 O rmud)
628
629 C compute absorption/scattering coefficients for radtrans
630 DO k=1,Nr
631 dz_k(k) = drF(k)*HFacC(i,j,k,bi,bj)
632 DO ilam = 1,tlam
633 c absorption by phyto
634 actot = 0.0
635 bctot = 0.0
636 bbctot = 0.0
637 DO np = 1,npmax
638 actot = actot + phychl_k(np,k)*aphy_chl(np,ilam)
639 bctot = bctot + phychl_k(np,k)*bphy_chl(np,ilam)
640 bbctot = bbctot + phychl_k(np,k)*bbphy_chl(np,ilam)
641 ENDDO
642 c particulate
643 apart_k(k,ilam) = part_k(k)*apart_P(ilam)
644 bpart_k(k,ilam) = part_k(k)*bpart_P(ilam)
645 bbpart_k(k,ilam) = part_k(k)*bbpart_P(ilam)
646 c add water and CDOM
647 a_k(k,ilam) = aw(ilam)+acdom_k(k,ilam)+actot+apart_k(k,ilam)
648 bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)
649 bb_k(k,ilam) = darwin_bbw*bw(ilam)+bbctot+bbpart_k(k,ilam)
650 bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))
651 c initialize output variables
652 Edz(ilam,k) = 0.0
653 Esz(ilam,k) = 0.0
654 Euz(ilam,k) = 0.0
655 Estop(ilam,k) = 0.0
656 Eutop(ilam,k) = 0.0
657 amp1(ilam,k) = 0.0
658 amp2(ilam,k) = 0.0
659 ENDDO
660 ENDDO
661
662 IF (darwin_radtrans_niter.GE.0) THEN
663 call MONOD_RADTRANS_ITER(
664 I dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
665 I darwin_radtrans_kmax,darwin_radtrans_niter,
666 O Edz,Esz,Euz,Eutop,
667 O tirrq,tirrwq,
668 O amp1,amp2,
669 I myThid)
670 ELSEIF (darwin_radtrans_niter.EQ.-1) THEN
671 c dzlocal ?????
672 call MONOD_RADTRANS(
673 I drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
674 O Edz,Esz,Euz,Eutop,
675 O tirrq,tirrwq,
676 I myThid)
677 ELSE
678 call MONOD_RADTRANS_DIRECT(
679 I dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
680 I darwin_radtrans_kmax,
681 O Edz,Esz,Euz,Estop,Eutop,
682 O tirrq,tirrwq,
683 O amp1,amp2,
684 I myThid)
685 #ifdef DAR_CHECK_IRR_CONT
686 IF( dz_k(1) .GT. 0.0 )THEN
687 DO ilam = 1,tlam
688 IF(Eswsf(ilam).GE.darwin_radmodThresh .OR.
689 & Edwsf(ilam).GE.darwin_radmodThresh ) THEN
690 IF(ABS(Estop(ilam,1)-Eswsf(ilam)) .GT. discEs )THEN
691 discEs = ABS(Estop(ilam,1)-Eswsf(ilam))
692 idiscEs = i
693 jdiscEs = j
694 kdiscEs = 1
695 ldiscEs = ilam
696 ENDIF
697 DO k=1,darwin_radtrans_kmax-1
698 IF(ABS(Estop(ilam,k+1)-Esz(ilam,k)) .GT. discEs)THEN
699 discEs = ABS(Estop(ilam,k+1)-Esz(ilam,k))
700 idiscEs = i
701 jdiscEs = j
702 kdiscEs = k+1
703 ldiscEs = ilam
704 ENDIF
705 IF(ABS(Eutop(ilam,k+1)-Euz(ilam,k)) .GT. discEu)THEN
706 discEu = ABS(Eutop(ilam,k+1)-Euz(ilam,k))
707 idiscEu = i
708 jdiscEu = j
709 kdiscEu = k+1
710 ldiscEu = ilam
711 ENDIF
712 ENDDO
713 ENDIF
714 ENDDO
715 ENDIF
716 #endif
717 ENDIF
718 c
719 c uses chl from prev timestep (as wavebands does)
720 c keep like this in case need to consider upwelling irradiance as affecting the grid box above
721 c will pass to plankton: PARw only, but will be for this timestep for RT and prev timestep for WAVBANDS
722 c
723 c now copy
724 DO k=1,Nr
725 PAR(i,j,k) = tirrq(k)
726 DO ilam = 1,tlam
727 PARw_k(ilam,k) = tirrwq(ilam,k)
728 ENDDO
729 ENDDO
730 #endif /* DAR_RADTRANS */
731
732 c oj: ???
733 c so PARw and PARwup from WAVEBANDS_1D are from previous timestep (attenuation done in plankton)
734 c but PARw and PARwup from WAVEBANDS_3D and RADTRANS are for the current timestep
735
736 #endif /* WAVEBANDS */
737
738 C ============================ k loop ==================================
739 c for each layer ...
740 do k= 1, NR
741 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
742
743 c make sure we only deal with positive definite numbers
744 c brute force...
745 po4l = max(Ptr(i,j,k,bi,bj,iPO4 ),0. _d 0)
746 no3l = max(Ptr(i,j,k,bi,bj,iNO3 ),0. _d 0)
747 fetl = max(Ptr(i,j,k,bi,bj,iFeT ),0. _d 0)
748 sil = max(Ptr(i,j,k,bi,bj,iSi ),0. _d 0)
749 dopl = max(Ptr(i,j,k,bi,bj,iDOP ),0. _d 0)
750 donl = max(Ptr(i,j,k,bi,bj,iDON ),0. _d 0)
751 dofel = max(Ptr(i,j,k,bi,bj,iDOFe ),0. _d 0)
752 DO nz = 1,nzmax
753 ZooP(nz) = max(Ptr(i,j,k,bi,bj,iZooP (nz)),0. _d 0)
754 ZooN(nz) = max(Ptr(i,j,k,bi,bj,iZooN (nz)),0. _d 0)
755 ZooFe(nz) = max(Ptr(i,j,k,bi,bj,iZooFe(nz)),0. _d 0)
756 ZooSi(nz) = max(Ptr(i,j,k,bi,bj,iZooSi(nz)),0. _d 0)
757 ENDDO
758 popl = max(Ptr(i,j,k,bi,bj,iPOP ),0. _d 0)
759 ponl = max(Ptr(i,j,k,bi,bj,iPON ),0. _d 0)
760 pofel = max(Ptr(i,j,k,bi,bj,iPOFe ),0. _d 0)
761 psil = max(Ptr(i,j,k,bi,bj,iPOSi ),0. _d 0)
762 NH4l = max(Ptr(i,j,k,bi,bj,iNH4 ),0. _d 0)
763 NO2l = max(Ptr(i,j,k,bi,bj,iNO2 ),0. _d 0)
764 #ifdef ALLOW_CDOM
765 cdoml = max(Ptr(i,j,k,bi,bj,iCDOM ),0. _d 0)
766 #endif
767 #ifdef ALLOW_CARBON
768 dicl = max(Ptr(i,j,k,bi,bj,iDIC ),0. _d 0)
769 docl = max(Ptr(i,j,k,bi,bj,iDOC ),0. _d 0)
770 pocl = max(Ptr(i,j,k,bi,bj,iPOC ),0. _d 0)
771 picl = max(Ptr(i,j,k,bi,bj,iPIC ),0. _d 0)
772 alkl = max(Ptr(i,j,k,bi,bj,iALK ),0. _d 0)
773 o2l = max(Ptr(i,j,k,bi,bj,iO2 ),0. _d 0)
774 DO nz = 1,nzmax
775 ZooCl(nz) = max(Ptr(i,j,k,bi,bj,iZooC (nz)),0. _d 0)
776 ENDDO
777 #endif
778
779 totphyC = 0. _d 0
780 DO np=1,npmax
781 totphyC = totphyC + R_PC(np)*Ptr(i,j,k,bi,bj,iPhy+np-1)
782 ENDDO
783
784 DO np = 1,npmax
785 Phy(np) = Phy_k(np,k)
786 #ifdef GEIDER
787 phychl(np) = phychl_k(np,k)
788 #endif
789 ENDDO
790
791 #ifdef DAR_DIAG_DIVER
792 Diver1(i,j,k)=0. _d 0
793 Diver2(i,j,k)=0. _d 0
794 Diver3(i,j,k)=0. _d 0
795 Diver4(i,j,k)=0. _d 0
796 totphy=0. _d 0
797 do np=1,npmax
798 totphy=totphy + Phy(np)
799 tmpphy(np)=Phy(np)
800 enddo
801 if (totphy.gt.diver_thresh0) then
802 do np=1,npmax
803 c simple threshhold
804 if (Phy(np).gt.diver_thresh1) then
805 Diver1(i,j,k)=Diver1(i,j,k)+1. _d 0
806 endif
807 c proportion of total biomass
808 if (Phy(np)/totphy.gt.diver_thresh2) then
809 Diver2(i,j,k)=Diver2(i,j,k)+1. _d 0
810 endif
811 enddo
812 c majority of biomass by finding rank order
813 biotot=0. _d 0
814 do np2=1,npmax
815 phymax=0. _d 0
816 do np=1,npmax
817 if (tmpphy(np).gt.phymax) then
818 phymax=tmpphy(np)
819 npsave=np
820 endif
821 enddo
822 if (biotot.lt.totphy*diver_thresh3) then
823 Diver3(i,j,k)=Diver3(i,j,k)+1. _d 0
824 endif
825 biotot=biotot+tmpphy(npsave)
826 tmpphy(npsave)=0. _d 0
827 if (np2.eq.1) then
828 maxphy=phymax
829 endif
830 enddo
831 c ratio of maximum species
832 do np=1,npmax
833 if (Phy(np).gt.diver_thresh4*maxphy) then
834 Diver4(i,j,k)=Diver4(i,j,k)+1. _d 0
835 endif
836 enddo
837 c totphy > thresh0
838 endif
839 c Shannon and Simpson indices
840 Shannon(i,j,k) = 0. _d 0
841 c note: minimal valid value is 1, but we set to zero below threshold
842 Simpson(i,j,k) = 0. _d 0
843 if (totphy.gt.shannon_thresh) then
844 do np=1,npmax
845 if (Phy(np) .gt. 0. _d 0) then
846 tmpphy(np) = Phy(np)/totphy
847 Shannon(i,j,k)=Shannon(i,j,k)+tmpphy(np)*LOG(tmpphy(np))
848 Simpson(i,j,k)=Simpson(i,j,k)+tmpphy(np)*tmpphy(np)
849 endif
850 enddo
851 Shannon(i,j,k) = -Shannon(i,j,k)
852 Simpson(i,j,k) = 1./Simpson(i,j,k)
853 endif
854 #endif
855
856 c..........................................................
857 c find local light
858 c..........................................................
859
860 PARl = PAR(i,j,k)
861 c..........................................................
862
863 c for explicit sinking of particulate matter and phytoplankton
864 if (k.eq.1) then
865 popupl =0. _d 0
866 ponupl =0. _d 0
867 pofeupl = 0. _d 0
868 psiupl = 0. _d 0
869 do np=1,npmax
870 Phyup(np)=0. _d 0
871 #ifdef DYNAMIC_CHL
872 chlup(np)=0. _d 0
873 #endif
874 enddo
875 #ifdef ALLOW_CARBON
876 pocupl = 0. _d 0
877 picupl = 0. _d 0
878 #endif
879 endif
880
881 #ifdef ALLOW_LONGSTEP
882 Tlocal = LS_theta(i,j,k,bi,bj)
883 Slocal = LS_salt(i,j,k,bi,bj)
884 #else
885 Tlocal = theta(i,j,k,bi,bj)
886 Slocal = salt(i,j,k,bi,bj)
887 #endif
888
889 c choice where to get pCO2 from
890 c taking from igsm dic run - fed through Tflux array
891 c pCO2local=surfaceForcingT(i,j,bi,bj)
892 c or from darwin carbon module
893 #ifdef ALLOW_CARBON
894 pCO2local=pCO2(i,j,bi,bj)
895 #else
896 pCO2local=280. _d -6
897 #endif
898
899 freefu = max(freefe(i,j,k),0. _d 0)
900 if (k.eq.1) then
901 inputFel = inputFe(i,j,bi,bj)
902 else
903 inputFel = 0. _d 0
904 endif
905
906 dzlocal = drF(k)*HFacC(i,j,k,bi,bj)
907 c set bottom=1.0 if the layer below is not ocean
908 ktmp=min(nR,k+1)
909 if(hFacC(i,j,ktmp,bi,bj).eq.0. _d 0.or.k.eq.Nr) then
910 bottom = 1.0 _d 0
911 else
912 bottom = 0.0 _d 0
913 endif
914
915 c set tendencies to 0
916 do np=1,npmax
917 dphy(np)=0. _d 0
918 enddo
919 do nz=1,nzmax
920 dzoop(nz)=0. _d 0
921 dzoon(nz)=0. _d 0
922 dzoofe(nz)=0. _d 0
923 dzoosi(nz)=0. _d 0
924 enddo
925 dPO4l=0. _d 0
926 dNO3l=0. _d 0
927 dFeTl=0. _d 0
928 dSil=0. _d 0
929 dDOPl=0. _d 0
930 dDONl=0. _d 0
931 dDOFel=0. _d 0
932 dPOPl=0. _d 0
933 dPONl=0. _d 0
934 dPOFel=0. _d 0
935 dPSil=0. _d 0
936 dNH4l=0. _d 0
937 dNO2l=0. _d 0
938 #ifdef DYNAMIC_CHL
939 do np=1,npmax
940 dphychl(np)=0. _d 0
941 enddo
942 #endif
943 #ifdef ALLOW_CDOM
944 dcdoml=0. _d 0
945 #endif
946 #ifdef ALLOW_CARBON
947 ddicl=0. _d 0
948 ddocl=0. _d 0
949 dpocl=0. _d 0
950 dpicl=0. _d 0
951 dalkl=0. _d 0
952 do2l=0. _d 0
953 do nz=1,nzmax
954 dzoocl(nz)=0. _d 0
955 enddo
956 #endif
957 c set other arguments to zero
958 PP=0. _d 0
959 Nfix=0. _d 0
960 denit=0. _d 0
961 do np=1,npmax
962 Rstarl(np)=0. _d 0
963 RNstarl(np)=0. _d 0
964 #ifdef DAR_DIAG_GROW
965 Growl(np)=0. _d 0
966 Growsql(np)=0. _d 0
967 #endif
968 #ifdef ALLOW_DIAZ
969 #ifdef DAR_DIAG_NFIXP
970 NfixPl(np)=0. _d 0
971 #endif
972 #endif
973 #ifdef DAR_DIAG_PARW
974 chl2cl(np)=0. _d 0
975 #endif
976 #ifdef DAR_DIAG_EK
977 Ekl(np)=0. _d 0
978 EkoverEl(np)=0. _d 0
979 do ilam=1,tlam
980 Ek_nll(np,ilam)=0. _d 0
981 EkoverE_nll(np,ilam)=0. _d 0
982 enddo
983 #endif
984 enddo
985
986
987 debug=0
988 c if (i.eq.20.and.j.eq.20.and.k.eq.1) debug=8
989 c if (i.eq.10.and.j.eq.10.and.k.eq.1) debug=100
990 c if (i.eq.1.and.j.eq.10.and.k.eq.1) debug=10
991 c if (i.eq.1.and.j.eq.1.and.k.eq.10) debug=14
992
993 if (debug.eq.7) print*,'PO4, DOP, POP, ZooP',
994 & PO4l, DOPl, POPl, zooP
995 if (debug.eq.7) print*,'NO3, NO2, NH4, DON, PON, ZooN',
996 & NO3l,NO2l,NH4l, DONl, PONl, ZooN
997 if (debug.eq.7) print*,'FeT, DOFe, POFe, Zoofe',
998 & FeTl, DOFel, POFel, zooFe
999 if (debug.eq.7) print*,'Si, Psi, zooSi',
1000 & Sil, PSil, zooSi
1001 if (debug.eq.7) print*,'Total Phy', sumpy, PARl, lite
1002 if (debug.eq.7) print*,'Phy', Phy
1003
1004 if (debug.eq.8) print*,'k, PARl, inputFel, dzlocal',
1005 & PARl, inputFel, dzlocal
1006
1007 c if (NO3l.eq.0. _d 0.or.NO2l.eq.0. _d 0
1008 c & .or.NH4l.eq.0. _d 0) then
1009 c print*,'QQ N zeros',i,j,k,NO3l,NO2l,NH4l
1010 c endif
1011
1012
1013 c ANNA pass extra variables if WAVEBANDS
1014 CALL MONOD_PLANKTON(
1015 U Phy,
1016 I zooP, zooN, zooFe, zooSi,
1017 O PP, Chl, Nfix, denit,
1018 I PO4l, NO3l, FeTl, Sil,
1019 I NO2l, NH4l,
1020 I DOPl, DONl, DOFel,
1021 I POPl, PONl, POFel, PSil,
1022 I phyup, popupl, ponupl,
1023 I pofeupl, psiupl,
1024 I PARl,
1025 I Tlocal, Slocal,
1026 I pCO2local,
1027 I freefu, inputFel,
1028 I bottom, dzlocal,
1029 O Rstarl, RNstarl,
1030 #ifdef DAR_DIAG_GROW
1031 O Growl, Growsql,
1032 #endif
1033 #ifdef ALLOW_DIAZ
1034 #ifdef DAR_DIAG_NFIXP
1035 O NfixPl,
1036 #endif
1037 #endif
1038 O dphy, dzooP, dzooN, dzooFe,
1039 O dzooSi,
1040 O dPO4l, dNO3l, dFeTl, dSil,
1041 O dNH4l, dNO2l,
1042 O dDOPl, dDONl, dDOFel,
1043 O dPOPl, dPONl, dPOFel, dPSil,
1044 #ifdef ALLOW_CARBON
1045 I dicl, docl, pocl, picl,
1046 I alkl, o2l, zoocl,
1047 I pocupl, picupl,
1048 O ddicl, ddocl, dpocl, dpicl,
1049 O dalkl, do2l, dzoocl,
1050 #endif
1051 #ifdef GEIDER
1052 O phychl,
1053 #ifdef DAR_DIAG_EK
1054 I Ekl, EkoverEl,
1055 #endif
1056 #ifdef DAR_DIAG_PARW
1057 I chl2cl,
1058 #endif
1059 #ifdef DYNAMIC_CHL
1060 I dphychl,
1061 I chlup,
1062 #ifdef DAR_DIAG_EK
1063 O accliml,
1064 #endif
1065 #endif
1066 #ifdef ALLOW_CDOM
1067 O dcdoml,
1068 I cdoml,
1069 #endif
1070 #ifdef WAVEBANDS
1071 I PARw_k(1,k),
1072 #ifdef DAR_DIAG_EK
1073 I Ek_nll, EkoverE_nll,
1074 #endif
1075 #endif
1076 #endif
1077 #ifdef ALLOW_PAR_DAY
1078 I PARday(i,j,k,bi,bj,PARiprev),
1079 #endif
1080 #ifdef DAR_DIAG_CHL
1081 O ChlGeiderlocal, ChlDoneylocal,
1082 O ChlCloernlocal,
1083 #endif
1084 I debug,
1085 I runtim,
1086 I MyThid)
1087
1088 c
1089 c if (i.eq.1.and.k.eq.1.and.j.eq.5) then
1090 c print*,i,j,k
1091 c print*,'NO3,No2,NH4', NO3l, NO2l, NH4l
1092 c print*,'dNO3 etc',dNO3l,dNH4l, dNO2l
1093 c print*,'PO4',PO4l,dPO4l
1094 c endif
1095 c
1096 #ifdef IRON_SED_SOURCE
1097 c only above minimum depth (continental shelf)
1098 if (rF(k).gt.-depthfesed) then
1099 c only if bottom layer
1100 if (bottom.eq.1.0 _d 0) then
1101 #ifdef IRON_SED_SOURCE_VARIABLE
1102 c calculate sink of POP into bottom layer
1103 tmp=(wp_sink*POPupl)/(dzlocal)
1104 c convert to dPOCl
1105 dFetl=dFetl+fesedflux_pcm*(tmp*106. _d 0)
1106 #else
1107 dFetl=dFetl+fesedflux/
1108 & (drF(k)*hFacC(i,j,k,bi,bj))
1109 #endif
1110 endif
1111 endif
1112 #endif
1113
1114
1115 popupl = POPl
1116 ponupl = PONl
1117 pofeupl = POFel
1118 psiupl = PSil
1119 do np=1,npmax
1120 Phyup(np) = Phy(np)
1121 #ifdef DYNAMIC_CHL
1122 chlup(np) = phychl(np)
1123 #endif
1124 enddo
1125
1126
1127 c
1128 #ifdef ALLOW_CARBON
1129 pocupl = POCl
1130 picupl = PICl
1131 c include surface forcing
1132 if (k.eq.1) then
1133 ddicl = ddicl + flxCO2(i,j)
1134 dalkl = dalkl + flxALK(i,j)
1135 do2l = do2l + flxO2(i,j)
1136 endif
1137 #endif
1138 c
1139 #ifdef CONS_SUPP
1140 c only works for two layer model
1141 if (k.eq.2) then
1142 dpo4l=0. _d 0
1143 dno3l=0. _d 0
1144 dfetl=0. _d 0
1145 dsil=0. _d 0
1146 endif
1147 #endif
1148 #ifdef RELAX_NUTS
1149 #ifdef DENIT_RELAX
1150 if (rF(k).lt.-depthdenit) then
1151 if (darwin_relaxscale.gt.0. _d 0) then
1152 IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1153 c Fanny's formulation
1154 tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1155 if (tmp.gt.0. _d 0) then
1156 dno3l=dno3l-(tmp/
1157 & darwin_relaxscale)
1158 denit=tmp/
1159 & darwin_relaxscale
1160 else
1161 denit=0. _d 0
1162 endif
1163 c --- end fanny's formulation
1164 ENDIF
1165 c steph's alternative
1166 c tmp=(Ptr(i,j,k,bi,bj,iNO3 )-
1167 c & 16. _d 0 * Ptr(i,j,k,bi,bj,iPO4 ))
1168 c if (tmp.gt.0. _d 0) then
1169 c dno3l=dno3l-(tmp/
1170 c & darwin_relaxscale)
1171 c denit=tmp/
1172 c & darwin_relaxscale
1173 c else
1174 c denit=0. _d 0
1175 c endif
1176 c ---- end steph's alternative
1177 endif
1178 endif
1179 #else
1180 if (darwin_relaxscale.gt.0. _d 0) then
1181 IF ( darwin_PO4_RelaxFile .NE. ' ' ) THEN
1182 tmp=(Ptr(i,j,k,bi,bj,iPO4 )-po4_obs(i,j,k,bi,bj))
1183 if (tmp.lt.0. _d 0) then
1184 dpo4l=dpo4l-(tmp/
1185 & darwin_relaxscale)
1186 endif
1187 ENDIF
1188 IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1189 tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1190 if (tmp.lt.0. _d 0) then
1191 dno3l=dno3l-(tmp/
1192 & darwin_relaxscale)
1193 endif
1194 ENDIF
1195 IF ( darwin_Fet_RelaxFile .NE. ' ' ) THEN
1196 tmp=(Ptr(i,j,k,bi,bj,iFeT )-fet_obs(i,j,k,bi,bj))
1197 if (tmp.lt.0. _d 0) then
1198 dfetl=dfetl-(tmp/
1199 & darwin_relaxscale)
1200 endif
1201 ENDIF
1202 IF ( darwin_Si_RelaxFile .NE. ' ' ) THEN
1203 tmp=( Ptr(i,j,k,bi,bj,iSi )-si_obs(i,j,k,bi,bj))
1204 if (tmp.lt.0. _d 0) then
1205 dsil=dsil-(tmp/
1206 & darwin_relaxscale)
1207 endif
1208 ENDIF
1209 endif
1210 #endif
1211 #endif
1212 #ifdef FLUX_NUTS
1213 dpo4l=dpo4l+po4_flx(i,j,k,bi,bj)
1214 dno3l=dno3l+no3_flx(i,j,k,bi,bj)
1215 dfetl=dfetl+fet_flx(i,j,k,bi,bj)
1216 dsil=dsil+si_flx(i,j,k,bi,bj)
1217 #endif
1218 c
1219 c now update main tracer arrays
1220 dtplankton = PTRACERS_dTLev(k)/float(nsubtime)
1221 Ptr(i,j,k,bi,bj,iPO4 ) = Ptr(i,j,k,bi,bj,iPO4) +
1222 & dtplankton*dpo4l
1223 Ptr(i,j,k,bi,bj,iNO3 ) = Ptr(i,j,k,bi,bj,iNO3) +
1224 & dtplankton*dno3l
1225 Ptr(i,j,k,bi,bj,iFeT ) = Ptr(i,j,k,bi,bj,iFeT) +
1226 & dtplankton*dfetl
1227 Ptr(i,j,k,bi,bj,iSi ) = Ptr(i,j,k,bi,bj,iSi ) +
1228 & dtplankton*dsil
1229 Ptr(i,j,k,bi,bj,iDOP ) = Ptr(i,j,k,bi,bj,iDOP) +
1230 & dtplankton*ddopl
1231 Ptr(i,j,k,bi,bj,iDON ) = Ptr(i,j,k,bi,bj,iDON) +
1232 & dtplankton*ddonl
1233 Ptr(i,j,k,bi,bj,iDOFe) = Ptr(i,j,k,bi,bj,iDOFe) +
1234 & dtplankton*ddofel
1235 Ptr(i,j,k,bi,bj,iPOP ) = Ptr(i,j,k,bi,bj,iPOP ) +
1236 & dtplankton*dpopl
1237 Ptr(i,j,k,bi,bj,iPON ) = Ptr(i,j,k,bi,bj,iPON ) +
1238 & dtplankton*dponl
1239 Ptr(i,j,k,bi,bj,iPOFe) = Ptr(i,j,k,bi,bj,iPOFe) +
1240 & dtplankton*dpofel
1241 Ptr(i,j,k,bi,bj,iPOSi) = Ptr(i,j,k,bi,bj,iPOSi) +
1242 & dtplankton*dpsil
1243 Ptr(i,j,k,bi,bj,iNH4 ) = Ptr(i,j,k,bi,bj,iNH4 ) +
1244 & dtplankton*dnh4l
1245 Ptr(i,j,k,bi,bj,iNO2 ) = Ptr(i,j,k,bi,bj,iNO2 ) +
1246 & dtplankton*dno2l
1247 DO nz = 1,nzmax
1248 Ptr(i,j,k,bi,bj,iZooP (nz)) = Ptr(i,j,k,bi,bj,iZooP (nz)) +
1249 & dtplankton*dzoop (nz)
1250 Ptr(i,j,k,bi,bj,iZooN (nz)) = Ptr(i,j,k,bi,bj,iZooN (nz)) +
1251 & dtplankton*dzoon (nz)
1252 Ptr(i,j,k,bi,bj,iZooFe(nz)) = Ptr(i,j,k,bi,bj,iZooFe(nz)) +
1253 & dtplankton*dzoofe(nz)
1254 Ptr(i,j,k,bi,bj,iZooSi(nz)) = Ptr(i,j,k,bi,bj,iZooSi(nz)) +
1255 & dtplankton*dzoosi(nz)
1256 ENDDO
1257 DO np = 1,npmax
1258 Ptr(i,j,k,bi,bj,iPhy+np-1) = Ptr(i,j,k,bi,bj,iPhy+np-1) +
1259 & dtplankton*dPhy(np)
1260 #ifdef GEIDER
1261 #ifdef DYNAMIC_CHL
1262 if (np.eq.1) Chl=0. _d 0
1263 Ptr(i,j,k,bi,bj,iChl+np-1) = Ptr(i,j,k,bi,bj,iChl+np-1) +
1264 & dtplankton*dphychl(np)
1265 c chltmp=Ptr(i,j,k,bi,bj,iChl+np-1)
1266 c phytmp=Ptr(i,j,k,bi,bj,iPhy+np-1)
1267 c Ptr(i,j,k,bi,bj,iChl+np-1)=
1268 c & max(chltmp,phytmp*R_PC(np)*chl2cmin(np))
1269 c if (np.eq.1.and.i.eq.1.and.j.eq.1.and.k.eq.1)
1270 c & print*,chltmp,phytmp,phytmp*R_PC(np)*chl2cmin(np),
1271 c & phytmp*R_PC(np)*chl2cmax(np)
1272 c in darwin_plankton this is stored for previous timestep. Reset here.
1273 Chl=Chl+Ptr(i,j,k,bi,bj,iChl+np-1)
1274 #else
1275 Chl_phy(i,j,k,bi,bj,np)=phychl(np)
1276 #endif
1277 #endif
1278 ENDDO
1279 #ifdef ALLOW_CDOM
1280 Ptr(i,j,k,bi,bj,iCDOM ) = Ptr(i,j,k,bi,bj,iCDOM ) +
1281 & dtplankton*dcdoml
1282 #endif
1283 #ifdef ALLOW_CARBON
1284 Ptr(i,j,k,bi,bj,iDIC ) = Ptr(i,j,k,bi,bj,iDIC ) +
1285 & dtplankton*ddicl
1286 Ptr(i,j,k,bi,bj,iDOC ) = Ptr(i,j,k,bi,bj,iDOC ) +
1287 & dtplankton*ddocl
1288 Ptr(i,j,k,bi,bj,iPOC ) = Ptr(i,j,k,bi,bj,iPOC ) +
1289 & dtplankton*dpocl
1290 Ptr(i,j,k,bi,bj,iPIC ) = Ptr(i,j,k,bi,bj,iPIC ) +
1291 & dtplankton*dpicl
1292 Ptr(i,j,k,bi,bj,iALK ) = Ptr(i,j,k,bi,bj,iALK ) +
1293 & dtplankton*dalkl
1294 Ptr(i,j,k,bi,bj,iO2 ) = Ptr(i,j,k,bi,bj,iO2 ) +
1295 & dtplankton*do2l
1296 DO nz = 1,nzmax
1297 Ptr(i,j,k,bi,bj,iZooC (nz)) = Ptr(i,j,k,bi,bj,iZooC (nz)) +
1298 & dtplankton*dzoocl (nz)
1299 ENDDO
1300 #endif
1301 c
1302 #ifdef ALLOW_MUTANTS
1303 cQQQQTEST
1304 if (debug.eq.11) then
1305 if (k.lt.8) then
1306 do np=1,60
1307 if(mod(np,4).eq. 1. _d 0)then
1308 np2=np+1
1309 np4=np+3
1310
1311 Coj: couldn't test this part after change Phynp -> Ptr(...,iPhy+np-1)
1312 Coj: used to be many copies of this:
1313 C if (dPhy(2).gt.dPhy(4).and.dPhy(4).gt.0. _d 0) then
1314 C print*,'QQQ dphy2 > dphy4',i,j,k,Phy2(i,j,k),
1315 C & Phy4(i,j,k), dPhy(2), dPhy(4)
1316 C endif
1317 C if (Phy2(i,j,k).gt.Phy4(i,j,k).and.
1318 C & Phy4(i,j,k).gt.0. _d 0) then
1319 C print*,'QQ phy02 > phy04',i,j,k,Phy2(i,j,k),
1320 C & Phy4(i,j,k), dPhy(2), dPhy(4)
1321 C endif
1322
1323 if (dPhy(np2).gt.dPhy(np4).and.dPhy(np4).gt.0. _d 0) then
1324 print*,'QQQ dphy',np2,' > dphy',np4,i,j,k,Phy2(i,j,k),
1325 & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1326 endif
1327 if (Ptr(i,j,k,bi,bj,iphy+np2-1).gt.Ptr(i,j,k,bi,bj,iPhy+np4-1)
1328 & .and. Ptr(i,j,k,bi,bj,iPhy+np4-1).gt.0. _d 0) then
1329 print*,'QQ phy',np2,' > ',np4,i,j,k,
1330 & Ptr(i,j,k,bi,bj,iPhy+np2-1),
1331 & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1332 endif
1333
1334 endif
1335 enddo ! np
1336 endif ! k
1337 endif
1338 #endif
1339
1340 #ifdef ALLOW_DIAGNOSTICS
1341 COJ for diagnostics
1342 PParr(i,j,k) = PP
1343 Nfixarr(i,j,k) = Nfix
1344 c ANNA_TAVE
1345 #ifdef WAVES_DIAG_PCHL
1346 DO np = 1,npmax
1347 Pchlarr(i,j,k,np) = phychl(np)
1348 ENDDO
1349 #endif
1350 c ANNA end TAVE
1351 #ifdef DAR_DIAG_RSTAR
1352 DO np = 1,npmax
1353 Rstararr(i,j,k,np) = Rstarl(np)
1354 ENDDO
1355 #endif
1356 #ifdef ALLOW_DIAZ
1357 #ifdef DAR_DIAG_NFIXP
1358 DO np = 1,npmax
1359 NfixParr(i,j,k,np) = NfixPl(np)
1360 ENDDO
1361 #endif
1362 #endif
1363 #ifdef DAR_DIAG_CHL
1364 GeiderChlarr(i,j,k) = ChlGeiderlocal
1365 DoneyChlarr(i,j,k) = ChlDoneylocal
1366 CloernChlarr(i,j,k) = ChlCloernlocal
1367 IF (totphyC .NE. 0. _d 0) THEN
1368 GeiderChl2Carr(i,j,k) = ChlGeiderlocal/totphyC
1369 DoneyChl2Carr(i,j,k) = ChlDoneylocal/totphyC
1370 CloernChl2Carr(i,j,k) = ChlCloernlocal/totphyC
1371 ELSE
1372 GeiderChl2Carr(i,j,k) = 0. _d 0
1373 DoneyChl2Carr(i,j,k) = 0. _d 0
1374 CloernChl2Carr(i,j,k) = 0. _d 0
1375 ENDIF
1376 #endif
1377 COJ
1378 #endif /* ALLOW_DIAGNOSTICS */
1379
1380 c total fixation (NOTE - STILL NEEDS GLOB SUM)
1381 tot_Nfix=tot_Nfix+
1382 & Nfix*rA(i,j,bi,bj)*rF(k)*hFacC(i,j,k,bi,bj)
1383
1384 #ifdef ALLOW_TIMEAVE
1385 c save averages
1386 c Phygrow1ave(i,j,k,bi,bj)=Phygrow1ave(i,j,k,bi,bj)+
1387 c & mu1*py1*deltaTclock
1388 c & /float(nsubtime)
1389 c Phygrow2ave(i,j,k,bi,bj)=Phygrow2ave(i,j,k,bi,bj)+
1390 c & mu2*py2*deltaTclock
1391 c & /float(nsubtime)
1392 c Zoograzave(i,j,k,bi,bj)=Zoograzave(i,j,k,bi,bj)+
1393 c & (gampn1*graz1*zo +gampn2*graz2*zo)*
1394 c & deltaTclock/float(nsubtime)
1395 #ifdef GEIDER
1396 Chlave(i,j,k,bi,bj)=Chlave(i,j,k,bi,bj)+
1397 & Chl*dtplankton
1398 #endif
1399 PARave(i,j,k,bi,bj)=PARave(i,j,k,bi,bj)+
1400 & PARl*dtplankton
1401 PPave(i,j,k,bi,bj)=PPave(i,j,k,bi,bj)+
1402 & PP*dtplankton
1403 Nfixave(i,j,k,bi,bj)=Nfixave(i,j,k,bi,bj)+
1404 & Nfix*dtplankton
1405 Denitave(i,j,k,bi,bj)=Denitave(i,j,k,bi,bj)+
1406 & denit*dtplankton
1407 #ifdef WAVES_DIAG_PCHL
1408 do np=1,npmax
1409 Pchlave(i,j,k,bi,bj,np)=Pchlave(i,j,k,bi,bj,np)+
1410 & phychl(np)*dtplankton
1411 enddo
1412 #endif
1413 #ifdef DAR_DIAG_PARW
1414 do ilam=1,tlam
1415 PARwave(i,j,k,bi,bj,ilam)=PARwave(i,j,k,bi,bj,ilam)+
1416 & PARw_k(ilam,k)*dtplankton
1417 enddo
1418 do np=1,npmax
1419 chl2cave(i,j,k,bi,bj,np)=chl2cave(i,j,k,bi,bj,np)+
1420 & chl2cl(np)*dtplankton
1421 enddo
1422 #endif
1423 #ifdef DAR_DIAG_ACDOM
1424 c print*,'acdom',k,acdom_k(k,darwin_diag_acdom_ilam)
1425 aCDOMave(i,j,k,bi,bj)=aCDOMave(i,j,k,bi,bj)+
1426 & acdom_k(k,darwin_diag_acdom_ilam)*dtplankton
1427 #endif
1428 #ifdef DAR_DIAG_IRR
1429 do ilam = 1,tlam
1430 if (k.EQ.1) then
1431 Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1432 & Edwsf(ilam)*dtplankton
1433 Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1434 & Eswsf(ilam)*dtplankton
1435 Coj no Eu at surface (yet)
1436 else
1437 Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1438 & Edz(ilam,k-1)*dtplankton
1439 Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1440 & Esz(ilam,k-1)*dtplankton
1441 Euave(i,j,k,bi,bj,ilam)=Euave(i,j,k,bi,bj,ilam)+
1442 & Euz(ilam,k-1)*dtplankton
1443 endif
1444 Estave(i,j,k,bi,bj,ilam)=Estave(i,j,k,bi,bj,ilam)+
1445 & Estop(ilam,k)*dtplankton
1446 Eutave(i,j,k,bi,bj,ilam)=Eutave(i,j,k,bi,bj,ilam)+
1447 & Eutop(ilam,k)*dtplankton
1448 enddo
1449 #endif
1450 #ifdef DAR_DIAG_IRR_AMPS
1451 do ilam = 1,tlam
1452 amp1ave(i,j,k,bi,bj,ilam)=amp1ave(i,j,k,bi,bj,ilam)+
1453 & amp1(ilam,k)*dtplankton
1454 amp2ave(i,j,k,bi,bj,ilam)=amp2ave(i,j,k,bi,bj,ilam)+
1455 & amp2(ilam,k)*dtplankton
1456 enddo
1457 #endif
1458 #ifdef DAR_DIAG_ABSORP
1459 do ilam = 1,tlam
1460 aave(i,j,k,bi,bj,ilam)=aave(i,j,k,bi,bj,ilam)+
1461 & a_k(k,ilam)*dtplankton
1462 enddo
1463 #endif
1464 #ifdef DAR_DIAG_SCATTER
1465 do ilam = 1,tlam
1466 btave(i,j,k,bi,bj,ilam)=btave(i,j,k,bi,bj,ilam)+
1467 & bt_k(k,ilam)*dtplankton
1468 bbave(i,j,k,bi,bj,ilam)=bbave(i,j,k,bi,bj,ilam)+
1469 & bb_k(k,ilam)*dtplankton
1470 enddo
1471 #endif
1472 #ifdef DAR_DIAG_PART_SCATTER
1473 do ilam = 1,tlam
1474 apartave(i,j,k,bi,bj,ilam)=apartave(i,j,k,bi,bj,ilam)+
1475 & apart_k(k,ilam)*dtplankton
1476 btpartave(i,j,k,bi,bj,ilam)=btpartave(i,j,k,bi,bj,ilam)+
1477 & bpart_k(k,ilam)*dtplankton
1478 bbpartave(i,j,k,bi,bj,ilam)=bbpartave(i,j,k,bi,bj,ilam)+
1479 & bbpart_k(k,ilam)*dtplankton
1480 enddo
1481 #endif
1482 #ifdef DAR_RADTRANS
1483 if (k.eq.1) then
1484 rmudave(i,j,bi,bj)=rmudave(i,j,bi,bj)+
1485 & rmud*dtplankton
1486 endif
1487 #endif
1488 #ifdef DAR_DIAG_EK
1489 do np=1,npmax
1490 Ekave(i,j,k,bi,bj,np)=Ekave(i,j,k,bi,bj,np)+
1491 & Ekl(np)*dtplankton
1492 EkoverEave(i,j,k,bi,bj,np)=EkoverEave(i,j,k,bi,bj,np)+
1493 & EkoverEl(np)*dtplankton
1494 acclimave(i,j,k,bi,bj,np)=acclimave(i,j,k,bi,bj,np)+
1495 & accliml(np)*dtplankton
1496 do ilam=1,tlam
1497 Ek_nlave(i,j,k,bi,bj,np,ilam)=
1498 & Ek_nlave(i,j,k,bi,bj,np,ilam)+
1499 & Ek_nll(np,ilam)*dtplankton
1500 EkoverE_nlave(i,j,k,bi,bj,np,ilam)=
1501 & EkoverE_nlave(i,j,k,bi,bj,np,ilam)+
1502 & EkoverE_nll(np,ilam)*dtplankton
1503 enddo
1504 enddo
1505 #endif
1506 #ifdef DAR_DIAG_RSTAR
1507 do np=1,npmax
1508 Rstarave(i,j,k,bi,bj,np)=Rstarave(i,j,k,bi,bj,np)+
1509 & Rstarl(np)*dtplankton
1510 RNstarave(i,j,k,bi,bj,np)=RNstarave(i,j,k,bi,bj,np)+
1511 & RNstarl(np)*dtplankton
1512 enddo
1513 #endif
1514 #ifdef DAR_DIAG_DIVER
1515 Diver1ave(i,j,k,bi,bj)=Diver1ave(i,j,k,bi,bj)+
1516 & Diver1(i,j,k)*dtplankton
1517 Diver2ave(i,j,k,bi,bj)=Diver2ave(i,j,k,bi,bj)+
1518 & Diver2(i,j,k)*dtplankton
1519 Diver3ave(i,j,k,bi,bj)=Diver3ave(i,j,k,bi,bj)+
1520 & Diver3(i,j,k)*dtplankton
1521 Diver4ave(i,j,k,bi,bj)=Diver4ave(i,j,k,bi,bj)+
1522 & Diver4(i,j,k)*dtplankton
1523 #endif
1524 #ifdef DAR_DIAG_GROW
1525 do np=1,npmax
1526 Growave(i,j,k,bi,bj,np)=Growave(i,j,k,bi,bj,np)+
1527 & Growl(np)*dtplankton
1528 Growsqave(i,j,k,bi,bj,np)=Growsqave(i,j,k,bi,bj,np)+
1529 & Growsql(np)*dtplankton
1530 enddo
1531 #endif
1532
1533 #ifdef ALLOW_DIAZ
1534 #ifdef DAR_DIAG_NFIXP
1535 do np=1,npmax
1536 NfixPave(i,j,k,bi,bj,np)=NfixPave(i,j,k,bi,bj,np)+
1537 & NfixPl(np)*dtplankton
1538 enddo
1539 #endif
1540 #endif
1541 #endif
1542
1543 #ifdef ALLOW_CARBON
1544 if (k.eq.1) then
1545 SURave(i,j,bi,bj) =SURave(i,j,bi,bj)+
1546 & flxCO2(i,j)*dtplankton
1547 SURCave(i,j,bi,bj) =SURCave(i,j,bi,bj)+
1548 & FluxCO2(i,j,bi,bj)*dtplankton
1549 SUROave(i,j,bi,bj) =SUROave(i,j,bi,bj)+
1550 & flxO2(i,j)*dtplankton
1551 pCO2ave(i,j,bi,bj) =pCO2ave(i,j,bi,bj)+
1552 & pCO2(i,j,bi,bj)*dtplankton
1553 pHave(i,j,bi,bj) =pHave(i,j,bi,bj)+
1554 & pH(i,j,bi,bj)*dtplankton
1555 endif
1556 #endif
1557 endif
1558 c end if hFac>0
1559
1560 enddo ! k
1561 c end layer loop
1562 c
1563
1564 ENDDO ! i
1565 ENDDO ! j
1566
1567 #ifdef ALLOW_PAR_DAY
1568 C 1 <-> 2
1569 PARiaccum = 3 - PARiprev
1570
1571 DO k=1,nR
1572 DO j=1,sNy
1573 DO i=1,sNx
1574 PARday(i,j,k,bi,bj,PARiaccum) =
1575 & PARday(i,j,k,bi,bj,PARiaccum) + PAR(i,j,k)
1576 ENDDO
1577 ENDDO
1578 ENDDO
1579
1580 phase = 0. _d 0
1581 itistime = DIFF_PHASE_MULTIPLE( phase, darwin_PARavPeriod,
1582 & newtime, dtsubtime)
1583
1584 IF ( itistime ) THEN
1585 C compute average
1586 nav = darwin_PARnav
1587 IF (newtime - baseTime .LT. darwin_PARavPeriod) THEN
1588 C incomplete period at beginning of run
1589 nav = NINT((newtime-baseTime)/dtsubtime)
1590 ENDIF
1591 DO k=1,nR
1592 DO j=1,sNy
1593 DO i=1,sNx
1594 PARday(i,j,k,bi,bj,PARiaccum) =
1595 & PARday(i,j,k,bi,bj,PARiaccum) / nav
1596 ENDDO
1597 ENDDO
1598 ENDDO
1599 C reset the other slot for averaging
1600 DO k=1,nR
1601 DO j=1,sNy
1602 DO i=1,sNx
1603 PARday(i,j,k,bi,bj,PARiprev) = 0. _d 0
1604 ENDDO
1605 ENDDO
1606 ENDDO
1607 ENDIF
1608 C itistime
1609 #endif
1610
1611 #ifdef DAR_CHECK_IRR_CONT
1612 i = myXGlobalLo-1+(bi-1)*sNx+idiscEs
1613 j = myYGlobalLo-1+(bj-1)*sNy+jdiscEs
1614 write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Es disc',
1615 & i,j,kdiscEs,ldiscEs,discEs
1616 i = myXGlobalLo-1+(bi-1)*sNx+idiscEu
1617 j = myYGlobalLo-1+(bj-1)*sNy+jdiscEu
1618 write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Eu disc',
1619 & i,j,kdiscEu,ldiscEu,discEu
1620 #endif
1621
1622 COJ fill diagnostics
1623 #ifdef ALLOW_DIAGNOSTICS
1624 IF ( useDiagnostics ) THEN
1625 diagname = ' '
1626 WRITE(diagname,'(A8)') 'PAR '
1627 CALL DIAGNOSTICS_FILL( PAR(1-Olx,1-Oly,1), diagname,
1628 & 0,Nr,2,bi,bj,myThid )
1629 WRITE(diagname,'(A8)') 'PP '
1630 CALL DIAGNOSTICS_FILL( PParr(1-Olx,1-Oly,1), diagname,
1631 & 0,Nr,2,bi,bj,myThid )
1632 WRITE(diagname,'(A8)') 'Nfix '
1633 CALL DIAGNOSTICS_FILL( Nfixarr(1-Olx,1-Oly,1), diagname,
1634 & 0,Nr,2,bi,bj,myThid )
1635 c ANNA_TAVE
1636 #ifdef WAVES_DIAG_PCHL
1637 DO np=1,MIN(99,npmax)
1638 WRITE(diagname,'(A5,I2.2,A1)') 'Pchl',np,' '
1639 CALL DIAGNOSTICS_FILL( Pchlarr(1-Olx,1-Oly,1,np), diagname,
1640 & 0,Nr,2,bi,bj,myThid )
1641 ENDDO
1642 #endif
1643 c ANNA end TAVE
1644 #ifdef DAR_DIAG_RSTAR
1645 DO np=1,MIN(99,npmax)
1646 WRITE(diagname,'(A5,I2.2,A1)') 'Rstar',np,' '
1647 CALL DIAGNOSTICS_FILL( Rstararr(1-Olx,1-Oly,1,np), diagname,
1648 & 0,Nr,2,bi,bj,myThid )
1649 ENDDO
1650 #endif
1651 #ifdef DAR_DIAG_DIVER
1652 WRITE(diagname,'(A8)') 'Diver1 '
1653 CALL DIAGNOSTICS_FILL( Diver1(1-Olx,1-Oly,1), diagname,
1654 & 0,Nr,2,bi,bj,myThid )
1655 WRITE(diagname,'(A8)') 'Diver2 '
1656 CALL DIAGNOSTICS_FILL( Diver2(1-Olx,1-Oly,1), diagname,
1657 & 0,Nr,2,bi,bj,myThid )
1658 WRITE(diagname,'(A8)') 'Diver3 '
1659 CALL DIAGNOSTICS_FILL( Diver3(1-Olx,1-Oly,1), diagname,
1660 & 0,Nr,2,bi,bj,myThid )
1661 WRITE(diagname,'(A8)') 'Diver4 '
1662 CALL DIAGNOSTICS_FILL( Diver4(1-Olx,1-Oly,1), diagname,
1663 & 0,Nr,2,bi,bj,myThid )
1664 WRITE(diagname,'(A8)') 'Shannon '
1665 CALL DIAGNOSTICS_FILL( Shannon(1-Olx,1-Oly,1), diagname,
1666 & 0,Nr,2,bi,bj,myThid )
1667 WRITE(diagname,'(A8)') 'Simpson '
1668 CALL DIAGNOSTICS_FILL( Simpson(1-Olx,1-Oly,1), diagname,
1669 & 0,Nr,2,bi,bj,myThid )
1670 #endif
1671 #ifdef ALLOW_DIAZ
1672 #ifdef DAR_DIAG_NFIXP
1673 DO np=1,MIN(99,npmax)
1674 WRITE(diagname,'(A5,I2.2,A1)') 'NfixP',np,' '
1675 CALL DIAGNOSTICS_FILL( NfixParr(1-Olx,1-Oly,1,np), diagname,
1676 & 0,Nr,2,bi,bj,myThid )
1677 ENDDO
1678 #endif
1679 #endif
1680 #ifdef DAR_DIAG_CHL
1681 CALL DIAGNOSTICS_FILL( GeiderChlarr(1-Olx,1-Oly,1), 'ChlGeide',
1682 & 0,Nr,2,bi,bj,myThid )
1683 CALL DIAGNOSTICS_FILL( GeiderChl2Carr(1-Olx,1-Oly,1),'Chl2CGei',
1684 & 0,Nr,2,bi,bj,myThid )
1685 CALL DIAGNOSTICS_FILL( DoneyChlarr(1-Olx,1-Oly,1), 'ChlDoney',
1686 & 0,Nr,2,bi,bj,myThid )
1687 CALL DIAGNOSTICS_FILL( DoneyChl2Carr(1-Olx,1-Oly,1), 'Chl2CDon',
1688 & 0,Nr,2,bi,bj,myThid )
1689 CALL DIAGNOSTICS_FILL( CloernChlarr(1-Olx,1-Oly,1), 'ChlCloer',
1690 & 0,Nr,2,bi,bj,myThid )
1691 CALL DIAGNOSTICS_FILL( CloernChl2Carr(1-Olx,1-Oly,1),'Chl2CClo',
1692 & 0,Nr,2,bi,bj,myThid )
1693 #endif
1694 #ifdef ALLOW_CARBON
1695 CALL DIAGNOSTICS_FILL( flxCO2(1-Olx,1-Oly), 'DICTFLX ',
1696 & 0,1,2,bi,bj,myThid )
1697 CALL DIAGNOSTICS_FILL( FluxCO2(1-Olx,1-Oly,bi,bj), 'DICCFLX ',
1698 & 0,1,2,bi,bj,myThid )
1699 CALL DIAGNOSTICS_FILL( flxO2(1-Olx,1-Oly), 'DICOFLX ',
1700 & 0,1,2,bi,bj,myThid )
1701 CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,bi,bj), 'DICPCO2 ',
1702 & 0,1,2,bi,bj,myThid )
1703 CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,bi,bj), 'DICPHAV ',
1704 & 0,1,2,bi,bj,myThid )
1705 #endif /* ALLOW_CARBON */
1706 ENDIF
1707 #endif /* ALLOW_DIAGNOSTICS */
1708 COJ
1709
1710 c determine iron partitioning - solve for free iron
1711 call darwin_fe_chem(bi,bj,iMin,iMax,jMin,jMax,
1712 & Ptr(1-OLx,1-OLy,1,bi,bj,iFeT), freefe,
1713 & myIter, mythid)
1714 c
1715 #ifdef ALLOW_TIMEAVE
1716 c save averages
1717 do k=1,nR
1718 dar_timeave(bi,bj,k)=dar_timeave(bi,bj,k)
1719 & +dtplankton
1720 #ifdef ALLOW_CARBON
1721 dic_timeave(bi,bj,k)=dic_timeave(bi,bj,k)
1722 & +dtplankton
1723 #endif
1724 enddo
1725 #endif
1726 c
1727 c -----------------------------------------------------
1728 ENDDO ! it
1729 c -----------------------------------------------------
1730 c end of bio-chemical time loop
1731 c
1732 RETURN
1733 END
1734 #endif /*MONOD*/
1735 #endif /*ALLOW_PTRACERS*/
1736
1737 C============================================================================

  ViewVC Help
Powered by ViewVC 1.1.22