/[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.14 - (show annotations) (download)
Thu Oct 25 15:58:24 2012 UTC (12 years, 9 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt64a_20121116, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt64b_20121224, ctrb_darwin2_ckpt64d_20130219
Changes since 1.13: +3 -2 lines
fix units when using insol

1 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F,v 1.13 2012/10/23 16:39:32 stephd 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 C convert W/m2 to uEin/s/m2
509 lite = sfac(j)*parconv*maskC(i,j,1,bi,bj)
510
511 #endif /* not USE_QSW */
512 #endif /* not READ_PAR */
513
514 c take ice coverage into account
515 c unless already done in seaice package
516 #if !(defined (ALLOW_SEAICE) && defined (USE_QSW))
517 lite = lite*(1. _d 0-fice(i,j,bi,bj))
518 #endif
519 #endif /* not(WAVEBANDS and OASIM) */
520
521 c ------------ LIGHT ATTENUATION: --------------------------------------
522 #ifndef WAVEBANDS
523 c ------------ SINGLE-BAND ATTENUATION ---------------------------------
524 atten=0. _d 0
525 do k=1,Nr
526 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
527 sumpyup = sumpy
528 sumpy = 0. _d 0
529 do np=1,npmax
530 #ifdef GEIDER
531 sumpy = sumpy + phychl_k(np,k)
532 #else
533 sumpy = sumpy + Phy_k(np,k)
534 #endif
535 enddo
536 atten= atten + (k0 + kc*sumpy)*5. _d -1*drF(k)
537 if (k.gt.1)then
538 atten = atten + (k0+kc*sumpyup)*5. _d -1*drF(k-1)
539 endif
540 PAR(i,j,k) = lite*exp(-atten)
541 endif
542 enddo
543
544 #else /* WAVEBANDS */
545 #ifndef DAR_RADTRANS
546 c ------------ WAVEBANDS W/O RADTRANS ----------------------------------
547 do ilam = 1,tlam
548 #ifdef OASIM
549 c add direct and diffuse, convert to uEin/m2/s/nm
550 PARwup(ilam) = WtouEins(ilam)*(oasim_ed(i,j,ilam,bi,bj)+
551 & oasim_es(i,j,ilam,bi,bj))
552 c and take ice fraction into account
553 c PARwup(ilam) = PARwup(ilam)*(1 _d 0 - fice(i,j,bi,bj))
554 #else
555 c sf is per nm; convert to per waveband
556 PARwup(ilam) = wb_width(ilam)*sf(ilam)*lite
557 #endif
558 enddo
559
560 do k=1,Nr
561 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
562 do ilam = 1,tlam
563 sumpy = 0.
564 do np = 1,npmax
565 c get total attenuation (absorption) by phyto at each wavelength
566 sumpy = sumpy + (phychl_k(np,k)*aphy_chl(np,ilam))
567 enddo
568 c for diagnostic
569 a_k(k,ilam) = aw(ilam) + sumpy + acdom_k(k,ilam)
570 atten = a_k(k,ilam)*drF(k)
571 PARwdn(ilam) = PARwup(ilam)*exp(-atten)
572 enddo
573
574 c find for the midpoint of the gridcell (gridcell mean)
575 do ilam = 1,tlam
576 C PARw_k(ilam,k)=exp((log(PARwup(ilam))+log(PARwdn(ilam)))*0.5)
577 PARw_k(ilam,k)=sqrt(PARwup(ilam)*PARwdn(ilam))
578 enddo
579
580 c cycle
581 do ilam=1,tlam
582 PARwup(ilam) = PARwdn(ilam)
583 enddo
584 else
585 do ilam=1,tlam
586 PARw_k(ilam,k) = 0. _d 0
587 enddo
588 endif
589
590 c sum wavebands for total PAR at the mid point of the gridcell (PARl)
591 PAR(i,j,k) = 0.
592 do ilam = 1,tlam
593 PAR(i,j,k) = PAR(i,j,k) + PARw_k(ilam,k)
594 enddo
595 enddo
596
597 #else /* DAR_RADTRANS */
598 c ------------ FULL RADIATIVE TRANSFER CODE ----------------------------
599 do ilam = 1,tlam
600 Edwsf(ilam) = oasim_ed(i,j,ilam,bi,bj)
601 Eswsf(ilam) = oasim_es(i,j,ilam,bi,bj)
602 enddo
603
604 #ifdef DAR_RADTRANS_USE_MODEL_CALENDAR
605 C simplified solar zenith angle for 360-day year and daily averaged light
606 C cos(solz) is average over daylight period
607 call darwin_solz360(newtime, YC(i,j,bi,bj),
608 O solz)
609
610 #else /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
611 C use calendar date for full solar zenith angle computation
612 C oj: average light effective at noon?
613 solz = 0.0 _d 0
614 isec = 12*3600
615 call radtrans_sfcsolz(rad,iyr,imon,iday,isec,
616 I XC(i,j,bi,bj),YC(i,j,bi,bj),
617 O solz)
618 #endif /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
619
620 c have Ed,Es below surface - no need for this adjustment on Ed Es for surface affects
621 c do ilam=1,tlam
622 c rod(ilam) = 0.0 _d 0
623 c ros(ilam) = 0.0 _d 0
624 c enddo
625
626 c compute 1/cos(zenith) for direct light below surface
627 call radtrans_sfcrmud(rad,solz,
628 O rmud)
629
630 C compute absorption/scattering coefficients for radtrans
631 DO k=1,Nr
632 dz_k(k) = drF(k)*HFacC(i,j,k,bi,bj)
633 DO ilam = 1,tlam
634 c absorption by phyto
635 actot = 0.0
636 bctot = 0.0
637 bbctot = 0.0
638 DO np = 1,npmax
639 actot = actot + phychl_k(np,k)*aphy_chl(np,ilam)
640 bctot = bctot + phychl_k(np,k)*bphy_chl(np,ilam)
641 bbctot = bbctot + phychl_k(np,k)*bbphy_chl(np,ilam)
642 ENDDO
643 c particulate
644 apart_k(k,ilam) = part_k(k)*apart_P(ilam)
645 bpart_k(k,ilam) = part_k(k)*bpart_P(ilam)
646 bbpart_k(k,ilam) = part_k(k)*bbpart_P(ilam)
647 c add water and CDOM
648 a_k(k,ilam) = aw(ilam)+acdom_k(k,ilam)+actot+apart_k(k,ilam)
649 bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)
650 bb_k(k,ilam) = darwin_bbw*bw(ilam)+bbctot+bbpart_k(k,ilam)
651 bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))
652 c initialize output variables
653 Edz(ilam,k) = 0.0
654 Esz(ilam,k) = 0.0
655 Euz(ilam,k) = 0.0
656 Estop(ilam,k) = 0.0
657 Eutop(ilam,k) = 0.0
658 amp1(ilam,k) = 0.0
659 amp2(ilam,k) = 0.0
660 ENDDO
661 ENDDO
662
663 IF (darwin_radtrans_niter.GE.0) THEN
664 call MONOD_RADTRANS_ITER(
665 I dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
666 I darwin_radtrans_kmax,darwin_radtrans_niter,
667 O Edz,Esz,Euz,Eutop,
668 O tirrq,tirrwq,
669 O amp1,amp2,
670 I myThid)
671 ELSEIF (darwin_radtrans_niter.EQ.-1) THEN
672 c dzlocal ?????
673 call MONOD_RADTRANS(
674 I drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
675 O Edz,Esz,Euz,Eutop,
676 O tirrq,tirrwq,
677 I myThid)
678 ELSE
679 call MONOD_RADTRANS_DIRECT(
680 I dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
681 I darwin_radtrans_kmax,
682 O Edz,Esz,Euz,Estop,Eutop,
683 O tirrq,tirrwq,
684 O amp1,amp2,
685 I myThid)
686 #ifdef DAR_CHECK_IRR_CONT
687 IF( dz_k(1) .GT. 0.0 )THEN
688 DO ilam = 1,tlam
689 IF(Eswsf(ilam).GE.darwin_radmodThresh .OR.
690 & Edwsf(ilam).GE.darwin_radmodThresh ) THEN
691 IF(ABS(Estop(ilam,1)-Eswsf(ilam)) .GT. discEs )THEN
692 discEs = ABS(Estop(ilam,1)-Eswsf(ilam))
693 idiscEs = i
694 jdiscEs = j
695 kdiscEs = 1
696 ldiscEs = ilam
697 ENDIF
698 DO k=1,darwin_radtrans_kmax-1
699 IF(ABS(Estop(ilam,k+1)-Esz(ilam,k)) .GT. discEs)THEN
700 discEs = ABS(Estop(ilam,k+1)-Esz(ilam,k))
701 idiscEs = i
702 jdiscEs = j
703 kdiscEs = k+1
704 ldiscEs = ilam
705 ENDIF
706 IF(ABS(Eutop(ilam,k+1)-Euz(ilam,k)) .GT. discEu)THEN
707 discEu = ABS(Eutop(ilam,k+1)-Euz(ilam,k))
708 idiscEu = i
709 jdiscEu = j
710 kdiscEu = k+1
711 ldiscEu = ilam
712 ENDIF
713 ENDDO
714 ENDIF
715 ENDDO
716 ENDIF
717 #endif
718 ENDIF
719 c
720 c uses chl from prev timestep (as wavebands does)
721 c keep like this in case need to consider upwelling irradiance as affecting the grid box above
722 c will pass to plankton: PARw only, but will be for this timestep for RT and prev timestep for WAVBANDS
723 c
724 c now copy
725 DO k=1,Nr
726 PAR(i,j,k) = tirrq(k)
727 DO ilam = 1,tlam
728 PARw_k(ilam,k) = tirrwq(ilam,k)
729 ENDDO
730 ENDDO
731 #endif /* DAR_RADTRANS */
732
733 c oj: ???
734 c so PARw and PARwup from WAVEBANDS_1D are from previous timestep (attenuation done in plankton)
735 c but PARw and PARwup from WAVEBANDS_3D and RADTRANS are for the current timestep
736
737 #endif /* WAVEBANDS */
738
739 C ============================ k loop ==================================
740 c for each layer ...
741 do k= 1, NR
742 if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
743
744 c make sure we only deal with positive definite numbers
745 c brute force...
746 po4l = max(Ptr(i,j,k,bi,bj,iPO4 ),0. _d 0)
747 no3l = max(Ptr(i,j,k,bi,bj,iNO3 ),0. _d 0)
748 fetl = max(Ptr(i,j,k,bi,bj,iFeT ),0. _d 0)
749 sil = max(Ptr(i,j,k,bi,bj,iSi ),0. _d 0)
750 dopl = max(Ptr(i,j,k,bi,bj,iDOP ),0. _d 0)
751 donl = max(Ptr(i,j,k,bi,bj,iDON ),0. _d 0)
752 dofel = max(Ptr(i,j,k,bi,bj,iDOFe ),0. _d 0)
753 DO nz = 1,nzmax
754 ZooP(nz) = max(Ptr(i,j,k,bi,bj,iZooP (nz)),0. _d 0)
755 ZooN(nz) = max(Ptr(i,j,k,bi,bj,iZooN (nz)),0. _d 0)
756 ZooFe(nz) = max(Ptr(i,j,k,bi,bj,iZooFe(nz)),0. _d 0)
757 ZooSi(nz) = max(Ptr(i,j,k,bi,bj,iZooSi(nz)),0. _d 0)
758 ENDDO
759 popl = max(Ptr(i,j,k,bi,bj,iPOP ),0. _d 0)
760 ponl = max(Ptr(i,j,k,bi,bj,iPON ),0. _d 0)
761 pofel = max(Ptr(i,j,k,bi,bj,iPOFe ),0. _d 0)
762 psil = max(Ptr(i,j,k,bi,bj,iPOSi ),0. _d 0)
763 NH4l = max(Ptr(i,j,k,bi,bj,iNH4 ),0. _d 0)
764 NO2l = max(Ptr(i,j,k,bi,bj,iNO2 ),0. _d 0)
765 #ifdef ALLOW_CDOM
766 cdoml = max(Ptr(i,j,k,bi,bj,iCDOM ),0. _d 0)
767 #endif
768 #ifdef ALLOW_CARBON
769 dicl = max(Ptr(i,j,k,bi,bj,iDIC ),0. _d 0)
770 docl = max(Ptr(i,j,k,bi,bj,iDOC ),0. _d 0)
771 pocl = max(Ptr(i,j,k,bi,bj,iPOC ),0. _d 0)
772 picl = max(Ptr(i,j,k,bi,bj,iPIC ),0. _d 0)
773 alkl = max(Ptr(i,j,k,bi,bj,iALK ),0. _d 0)
774 o2l = max(Ptr(i,j,k,bi,bj,iO2 ),0. _d 0)
775 DO nz = 1,nzmax
776 ZooCl(nz) = max(Ptr(i,j,k,bi,bj,iZooC (nz)),0. _d 0)
777 ENDDO
778 #endif
779
780 totphyC = 0. _d 0
781 DO np=1,npmax
782 totphyC = totphyC + R_PC(np)*Ptr(i,j,k,bi,bj,iPhy+np-1)
783 ENDDO
784
785 DO np = 1,npmax
786 Phy(np) = Phy_k(np,k)
787 #ifdef GEIDER
788 phychl(np) = phychl_k(np,k)
789 #endif
790 ENDDO
791
792 #ifdef DAR_DIAG_DIVER
793 Diver1(i,j,k)=0. _d 0
794 Diver2(i,j,k)=0. _d 0
795 Diver3(i,j,k)=0. _d 0
796 Diver4(i,j,k)=0. _d 0
797 totphy=0. _d 0
798 do np=1,npmax
799 totphy=totphy + Phy(np)
800 tmpphy(np)=Phy(np)
801 enddo
802 if (totphy.gt.diver_thresh0) then
803 do np=1,npmax
804 c simple threshhold
805 if (Phy(np).gt.diver_thresh1) then
806 Diver1(i,j,k)=Diver1(i,j,k)+1. _d 0
807 endif
808 c proportion of total biomass
809 if (Phy(np)/totphy.gt.diver_thresh2) then
810 Diver2(i,j,k)=Diver2(i,j,k)+1. _d 0
811 endif
812 enddo
813 c majority of biomass by finding rank order
814 biotot=0. _d 0
815 do np2=1,npmax
816 phymax=0. _d 0
817 do np=1,npmax
818 if (tmpphy(np).gt.phymax) then
819 phymax=tmpphy(np)
820 npsave=np
821 endif
822 enddo
823 if (biotot.lt.totphy*diver_thresh3) then
824 Diver3(i,j,k)=Diver3(i,j,k)+1. _d 0
825 endif
826 biotot=biotot+tmpphy(npsave)
827 tmpphy(npsave)=0. _d 0
828 if (np2.eq.1) then
829 maxphy=phymax
830 endif
831 enddo
832 c ratio of maximum species
833 do np=1,npmax
834 if (Phy(np).gt.diver_thresh4*maxphy) then
835 Diver4(i,j,k)=Diver4(i,j,k)+1. _d 0
836 endif
837 enddo
838 c totphy > thresh0
839 endif
840 c Shannon and Simpson indices
841 Shannon(i,j,k) = 0. _d 0
842 c note: minimal valid value is 1, but we set to zero below threshold
843 Simpson(i,j,k) = 0. _d 0
844 if (totphy.gt.shannon_thresh) then
845 do np=1,npmax
846 if (Phy(np) .gt. 0. _d 0) then
847 tmpphy(np) = Phy(np)/totphy
848 Shannon(i,j,k)=Shannon(i,j,k)+tmpphy(np)*LOG(tmpphy(np))
849 Simpson(i,j,k)=Simpson(i,j,k)+tmpphy(np)*tmpphy(np)
850 endif
851 enddo
852 Shannon(i,j,k) = -Shannon(i,j,k)
853 Simpson(i,j,k) = 1./Simpson(i,j,k)
854 endif
855 #endif
856
857 c..........................................................
858 c find local light
859 c..........................................................
860
861 PARl = PAR(i,j,k)
862 c..........................................................
863
864 c for explicit sinking of particulate matter and phytoplankton
865 if (k.eq.1) then
866 popupl =0. _d 0
867 ponupl =0. _d 0
868 pofeupl = 0. _d 0
869 psiupl = 0. _d 0
870 do np=1,npmax
871 Phyup(np)=0. _d 0
872 #ifdef DYNAMIC_CHL
873 chlup(np)=0. _d 0
874 #endif
875 enddo
876 #ifdef ALLOW_CARBON
877 pocupl = 0. _d 0
878 picupl = 0. _d 0
879 #endif
880 endif
881
882 #ifdef ALLOW_LONGSTEP
883 Tlocal = LS_theta(i,j,k,bi,bj)
884 Slocal = LS_salt(i,j,k,bi,bj)
885 #else
886 Tlocal = theta(i,j,k,bi,bj)
887 Slocal = salt(i,j,k,bi,bj)
888 #endif
889
890 c choice where to get pCO2 from
891 c taking from igsm dic run - fed through Tflux array
892 c pCO2local=surfaceForcingT(i,j,bi,bj)
893 c or from darwin carbon module
894 #ifdef ALLOW_CARBON
895 pCO2local=pCO2(i,j,bi,bj)
896 #else
897 pCO2local=280. _d -6
898 #endif
899
900 freefu = max(freefe(i,j,k),0. _d 0)
901 if (k.eq.1) then
902 inputFel = inputFe(i,j,bi,bj)
903 else
904 inputFel = 0. _d 0
905 endif
906
907 dzlocal = drF(k)*HFacC(i,j,k,bi,bj)
908 c set bottom=1.0 if the layer below is not ocean
909 ktmp=min(nR,k+1)
910 if(hFacC(i,j,ktmp,bi,bj).eq.0. _d 0.or.k.eq.Nr) then
911 bottom = 1.0 _d 0
912 else
913 bottom = 0.0 _d 0
914 endif
915
916 c set tendencies to 0
917 do np=1,npmax
918 dphy(np)=0. _d 0
919 enddo
920 do nz=1,nzmax
921 dzoop(nz)=0. _d 0
922 dzoon(nz)=0. _d 0
923 dzoofe(nz)=0. _d 0
924 dzoosi(nz)=0. _d 0
925 enddo
926 dPO4l=0. _d 0
927 dNO3l=0. _d 0
928 dFeTl=0. _d 0
929 dSil=0. _d 0
930 dDOPl=0. _d 0
931 dDONl=0. _d 0
932 dDOFel=0. _d 0
933 dPOPl=0. _d 0
934 dPONl=0. _d 0
935 dPOFel=0. _d 0
936 dPSil=0. _d 0
937 dNH4l=0. _d 0
938 dNO2l=0. _d 0
939 #ifdef DYNAMIC_CHL
940 do np=1,npmax
941 dphychl(np)=0. _d 0
942 enddo
943 #endif
944 #ifdef ALLOW_CDOM
945 dcdoml=0. _d 0
946 #endif
947 #ifdef ALLOW_CARBON
948 ddicl=0. _d 0
949 ddocl=0. _d 0
950 dpocl=0. _d 0
951 dpicl=0. _d 0
952 dalkl=0. _d 0
953 do2l=0. _d 0
954 do nz=1,nzmax
955 dzoocl(nz)=0. _d 0
956 enddo
957 #endif
958 c set other arguments to zero
959 PP=0. _d 0
960 Nfix=0. _d 0
961 denit=0. _d 0
962 do np=1,npmax
963 Rstarl(np)=0. _d 0
964 RNstarl(np)=0. _d 0
965 #ifdef DAR_DIAG_GROW
966 Growl(np)=0. _d 0
967 Growsql(np)=0. _d 0
968 #endif
969 #ifdef ALLOW_DIAZ
970 #ifdef DAR_DIAG_NFIXP
971 NfixPl(np)=0. _d 0
972 #endif
973 #endif
974 #ifdef DAR_DIAG_PARW
975 chl2cl(np)=0. _d 0
976 #endif
977 #ifdef DAR_DIAG_EK
978 Ekl(np)=0. _d 0
979 EkoverEl(np)=0. _d 0
980 do ilam=1,tlam
981 Ek_nll(np,ilam)=0. _d 0
982 EkoverE_nll(np,ilam)=0. _d 0
983 enddo
984 #endif
985 enddo
986
987
988 debug=0
989 c if (i.eq.20.and.j.eq.20.and.k.eq.1) debug=8
990 c if (i.eq.10.and.j.eq.10.and.k.eq.1) debug=100
991 c if (i.eq.1.and.j.eq.10.and.k.eq.1) debug=10
992 c if (i.eq.1.and.j.eq.1.and.k.eq.10) debug=14
993
994 if (debug.eq.7) print*,'PO4, DOP, POP, ZooP',
995 & PO4l, DOPl, POPl, zooP
996 if (debug.eq.7) print*,'NO3, NO2, NH4, DON, PON, ZooN',
997 & NO3l,NO2l,NH4l, DONl, PONl, ZooN
998 if (debug.eq.7) print*,'FeT, DOFe, POFe, Zoofe',
999 & FeTl, DOFel, POFel, zooFe
1000 if (debug.eq.7) print*,'Si, Psi, zooSi',
1001 & Sil, PSil, zooSi
1002 if (debug.eq.7) print*,'Total Phy', sumpy, PARl, lite
1003 if (debug.eq.7) print*,'Phy', Phy
1004
1005 if (debug.eq.8) print*,'k, PARl, inputFel, dzlocal',
1006 & PARl, inputFel, dzlocal
1007
1008 c if (NO3l.eq.0. _d 0.or.NO2l.eq.0. _d 0
1009 c & .or.NH4l.eq.0. _d 0) then
1010 c print*,'QQ N zeros',i,j,k,NO3l,NO2l,NH4l
1011 c endif
1012
1013
1014 c ANNA pass extra variables if WAVEBANDS
1015 CALL MONOD_PLANKTON(
1016 U Phy,
1017 I zooP, zooN, zooFe, zooSi,
1018 O PP, Chl, Nfix, denit,
1019 I PO4l, NO3l, FeTl, Sil,
1020 I NO2l, NH4l,
1021 I DOPl, DONl, DOFel,
1022 I POPl, PONl, POFel, PSil,
1023 I phyup, popupl, ponupl,
1024 I pofeupl, psiupl,
1025 I PARl,
1026 I Tlocal, Slocal,
1027 I pCO2local,
1028 I freefu, inputFel,
1029 I bottom, dzlocal,
1030 O Rstarl, RNstarl,
1031 #ifdef DAR_DIAG_GROW
1032 O Growl, Growsql,
1033 #endif
1034 #ifdef ALLOW_DIAZ
1035 #ifdef DAR_DIAG_NFIXP
1036 O NfixPl,
1037 #endif
1038 #endif
1039 O dphy, dzooP, dzooN, dzooFe,
1040 O dzooSi,
1041 O dPO4l, dNO3l, dFeTl, dSil,
1042 O dNH4l, dNO2l,
1043 O dDOPl, dDONl, dDOFel,
1044 O dPOPl, dPONl, dPOFel, dPSil,
1045 #ifdef ALLOW_CARBON
1046 I dicl, docl, pocl, picl,
1047 I alkl, o2l, zoocl,
1048 I pocupl, picupl,
1049 O ddicl, ddocl, dpocl, dpicl,
1050 O dalkl, do2l, dzoocl,
1051 #endif
1052 #ifdef GEIDER
1053 O phychl,
1054 #ifdef DAR_DIAG_EK
1055 I Ekl, EkoverEl,
1056 #endif
1057 #ifdef DAR_DIAG_PARW
1058 I chl2cl,
1059 #endif
1060 #ifdef DYNAMIC_CHL
1061 I dphychl,
1062 I chlup,
1063 #ifdef DAR_DIAG_EK
1064 O accliml,
1065 #endif
1066 #endif
1067 #ifdef ALLOW_CDOM
1068 O dcdoml,
1069 I cdoml,
1070 #endif
1071 #ifdef WAVEBANDS
1072 I PARw_k(1,k),
1073 #ifdef DAR_DIAG_EK
1074 I Ek_nll, EkoverE_nll,
1075 #endif
1076 #endif
1077 #endif
1078 #ifdef ALLOW_PAR_DAY
1079 I PARday(i,j,k,bi,bj,PARiprev),
1080 #endif
1081 #ifdef DAR_DIAG_CHL
1082 O ChlGeiderlocal, ChlDoneylocal,
1083 O ChlCloernlocal,
1084 #endif
1085 I debug,
1086 I runtim,
1087 I MyThid)
1088
1089 c
1090 c if (i.eq.1.and.k.eq.1.and.j.eq.5) then
1091 c print*,i,j,k
1092 c print*,'NO3,No2,NH4', NO3l, NO2l, NH4l
1093 c print*,'dNO3 etc',dNO3l,dNH4l, dNO2l
1094 c print*,'PO4',PO4l,dPO4l
1095 c endif
1096 c
1097 #ifdef IRON_SED_SOURCE
1098 c only above minimum depth (continental shelf)
1099 if (rF(k).gt.-depthfesed) then
1100 c only if bottom layer
1101 if (bottom.eq.1.0 _d 0) then
1102 #ifdef IRON_SED_SOURCE_VARIABLE
1103 c calculate sink of POP into bottom layer
1104 tmp=(wp_sink*POPupl)/(dzlocal)
1105 c convert to dPOCl
1106 dFetl=dFetl+fesedflux_pcm*(tmp*106. _d 0)
1107 #else
1108 dFetl=dFetl+fesedflux/
1109 & (drF(k)*hFacC(i,j,k,bi,bj))
1110 #endif
1111 endif
1112 endif
1113 #endif
1114
1115
1116 popupl = POPl
1117 ponupl = PONl
1118 pofeupl = POFel
1119 psiupl = PSil
1120 do np=1,npmax
1121 Phyup(np) = Phy(np)
1122 #ifdef DYNAMIC_CHL
1123 chlup(np) = phychl(np)
1124 #endif
1125 enddo
1126
1127
1128 c
1129 #ifdef ALLOW_CARBON
1130 pocupl = POCl
1131 picupl = PICl
1132 c include surface forcing
1133 if (k.eq.1) then
1134 ddicl = ddicl + flxCO2(i,j)
1135 dalkl = dalkl + flxALK(i,j)
1136 do2l = do2l + flxO2(i,j)
1137 endif
1138 #endif
1139 c
1140 #ifdef CONS_SUPP
1141 c only works for two layer model
1142 if (k.eq.2) then
1143 dpo4l=0. _d 0
1144 dno3l=0. _d 0
1145 dfetl=0. _d 0
1146 dsil=0. _d 0
1147 endif
1148 #endif
1149 #ifdef RELAX_NUTS
1150 #ifdef DENIT_RELAX
1151 if (rF(k).lt.-depthdenit) then
1152 if (darwin_relaxscale.gt.0. _d 0) then
1153 IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1154 c Fanny's formulation
1155 tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1156 if (tmp.gt.0. _d 0) then
1157 dno3l=dno3l-(tmp/
1158 & darwin_relaxscale)
1159 denit=tmp/
1160 & darwin_relaxscale
1161 else
1162 denit=0. _d 0
1163 endif
1164 c --- end fanny's formulation
1165 ENDIF
1166 c steph's alternative
1167 c tmp=(Ptr(i,j,k,bi,bj,iNO3 )-
1168 c & 16. _d 0 * Ptr(i,j,k,bi,bj,iPO4 ))
1169 c if (tmp.gt.0. _d 0) then
1170 c dno3l=dno3l-(tmp/
1171 c & darwin_relaxscale)
1172 c denit=tmp/
1173 c & darwin_relaxscale
1174 c else
1175 c denit=0. _d 0
1176 c endif
1177 c ---- end steph's alternative
1178 endif
1179 endif
1180 #else
1181 if (darwin_relaxscale.gt.0. _d 0) then
1182 IF ( darwin_PO4_RelaxFile .NE. ' ' ) THEN
1183 tmp=(Ptr(i,j,k,bi,bj,iPO4 )-po4_obs(i,j,k,bi,bj))
1184 if (tmp.lt.0. _d 0) then
1185 dpo4l=dpo4l-(tmp/
1186 & darwin_relaxscale)
1187 endif
1188 ENDIF
1189 IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1190 tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1191 if (tmp.lt.0. _d 0) then
1192 dno3l=dno3l-(tmp/
1193 & darwin_relaxscale)
1194 endif
1195 ENDIF
1196 IF ( darwin_Fet_RelaxFile .NE. ' ' ) THEN
1197 tmp=(Ptr(i,j,k,bi,bj,iFeT )-fet_obs(i,j,k,bi,bj))
1198 if (tmp.lt.0. _d 0) then
1199 dfetl=dfetl-(tmp/
1200 & darwin_relaxscale)
1201 endif
1202 ENDIF
1203 IF ( darwin_Si_RelaxFile .NE. ' ' ) THEN
1204 tmp=( Ptr(i,j,k,bi,bj,iSi )-si_obs(i,j,k,bi,bj))
1205 if (tmp.lt.0. _d 0) then
1206 dsil=dsil-(tmp/
1207 & darwin_relaxscale)
1208 endif
1209 ENDIF
1210 endif
1211 #endif
1212 #endif
1213 #ifdef FLUX_NUTS
1214 dpo4l=dpo4l+po4_flx(i,j,k,bi,bj)
1215 dno3l=dno3l+no3_flx(i,j,k,bi,bj)
1216 dfetl=dfetl+fet_flx(i,j,k,bi,bj)
1217 dsil=dsil+si_flx(i,j,k,bi,bj)
1218 #endif
1219 c
1220 c now update main tracer arrays
1221 dtplankton = PTRACERS_dTLev(k)/float(nsubtime)
1222 Ptr(i,j,k,bi,bj,iPO4 ) = Ptr(i,j,k,bi,bj,iPO4) +
1223 & dtplankton*dpo4l
1224 Ptr(i,j,k,bi,bj,iNO3 ) = Ptr(i,j,k,bi,bj,iNO3) +
1225 & dtplankton*dno3l
1226 Ptr(i,j,k,bi,bj,iFeT ) = Ptr(i,j,k,bi,bj,iFeT) +
1227 & dtplankton*dfetl
1228 Ptr(i,j,k,bi,bj,iSi ) = Ptr(i,j,k,bi,bj,iSi ) +
1229 & dtplankton*dsil
1230 Ptr(i,j,k,bi,bj,iDOP ) = Ptr(i,j,k,bi,bj,iDOP) +
1231 & dtplankton*ddopl
1232 Ptr(i,j,k,bi,bj,iDON ) = Ptr(i,j,k,bi,bj,iDON) +
1233 & dtplankton*ddonl
1234 Ptr(i,j,k,bi,bj,iDOFe) = Ptr(i,j,k,bi,bj,iDOFe) +
1235 & dtplankton*ddofel
1236 Ptr(i,j,k,bi,bj,iPOP ) = Ptr(i,j,k,bi,bj,iPOP ) +
1237 & dtplankton*dpopl
1238 Ptr(i,j,k,bi,bj,iPON ) = Ptr(i,j,k,bi,bj,iPON ) +
1239 & dtplankton*dponl
1240 Ptr(i,j,k,bi,bj,iPOFe) = Ptr(i,j,k,bi,bj,iPOFe) +
1241 & dtplankton*dpofel
1242 Ptr(i,j,k,bi,bj,iPOSi) = Ptr(i,j,k,bi,bj,iPOSi) +
1243 & dtplankton*dpsil
1244 Ptr(i,j,k,bi,bj,iNH4 ) = Ptr(i,j,k,bi,bj,iNH4 ) +
1245 & dtplankton*dnh4l
1246 Ptr(i,j,k,bi,bj,iNO2 ) = Ptr(i,j,k,bi,bj,iNO2 ) +
1247 & dtplankton*dno2l
1248 DO nz = 1,nzmax
1249 Ptr(i,j,k,bi,bj,iZooP (nz)) = Ptr(i,j,k,bi,bj,iZooP (nz)) +
1250 & dtplankton*dzoop (nz)
1251 Ptr(i,j,k,bi,bj,iZooN (nz)) = Ptr(i,j,k,bi,bj,iZooN (nz)) +
1252 & dtplankton*dzoon (nz)
1253 Ptr(i,j,k,bi,bj,iZooFe(nz)) = Ptr(i,j,k,bi,bj,iZooFe(nz)) +
1254 & dtplankton*dzoofe(nz)
1255 Ptr(i,j,k,bi,bj,iZooSi(nz)) = Ptr(i,j,k,bi,bj,iZooSi(nz)) +
1256 & dtplankton*dzoosi(nz)
1257 ENDDO
1258 DO np = 1,npmax
1259 Ptr(i,j,k,bi,bj,iPhy+np-1) = Ptr(i,j,k,bi,bj,iPhy+np-1) +
1260 & dtplankton*dPhy(np)
1261 #ifdef GEIDER
1262 #ifdef DYNAMIC_CHL
1263 if (np.eq.1) Chl=0. _d 0
1264 Ptr(i,j,k,bi,bj,iChl+np-1) = Ptr(i,j,k,bi,bj,iChl+np-1) +
1265 & dtplankton*dphychl(np)
1266 c chltmp=Ptr(i,j,k,bi,bj,iChl+np-1)
1267 c phytmp=Ptr(i,j,k,bi,bj,iPhy+np-1)
1268 c Ptr(i,j,k,bi,bj,iChl+np-1)=
1269 c & max(chltmp,phytmp*R_PC(np)*chl2cmin(np))
1270 c if (np.eq.1.and.i.eq.1.and.j.eq.1.and.k.eq.1)
1271 c & print*,chltmp,phytmp,phytmp*R_PC(np)*chl2cmin(np),
1272 c & phytmp*R_PC(np)*chl2cmax(np)
1273 c in darwin_plankton this is stored for previous timestep. Reset here.
1274 Chl=Chl+Ptr(i,j,k,bi,bj,iChl+np-1)
1275 #else
1276 Chl_phy(i,j,k,bi,bj,np)=phychl(np)
1277 #endif
1278 #endif
1279 ENDDO
1280 #ifdef ALLOW_CDOM
1281 Ptr(i,j,k,bi,bj,iCDOM ) = Ptr(i,j,k,bi,bj,iCDOM ) +
1282 & dtplankton*dcdoml
1283 #endif
1284 #ifdef ALLOW_CARBON
1285 Ptr(i,j,k,bi,bj,iDIC ) = Ptr(i,j,k,bi,bj,iDIC ) +
1286 & dtplankton*ddicl
1287 Ptr(i,j,k,bi,bj,iDOC ) = Ptr(i,j,k,bi,bj,iDOC ) +
1288 & dtplankton*ddocl
1289 Ptr(i,j,k,bi,bj,iPOC ) = Ptr(i,j,k,bi,bj,iPOC ) +
1290 & dtplankton*dpocl
1291 Ptr(i,j,k,bi,bj,iPIC ) = Ptr(i,j,k,bi,bj,iPIC ) +
1292 & dtplankton*dpicl
1293 Ptr(i,j,k,bi,bj,iALK ) = Ptr(i,j,k,bi,bj,iALK ) +
1294 & dtplankton*dalkl
1295 Ptr(i,j,k,bi,bj,iO2 ) = Ptr(i,j,k,bi,bj,iO2 ) +
1296 & dtplankton*do2l
1297 DO nz = 1,nzmax
1298 Ptr(i,j,k,bi,bj,iZooC (nz)) = Ptr(i,j,k,bi,bj,iZooC (nz)) +
1299 & dtplankton*dzoocl (nz)
1300 ENDDO
1301 #endif
1302 c
1303 #ifdef ALLOW_MUTANTS
1304 cQQQQTEST
1305 if (debug.eq.11) then
1306 if (k.lt.8) then
1307 do np=1,60
1308 if(mod(np,4).eq. 1. _d 0)then
1309 np2=np+1
1310 np4=np+3
1311
1312 Coj: couldn't test this part after change Phynp -> Ptr(...,iPhy+np-1)
1313 Coj: used to be many copies of this:
1314 C if (dPhy(2).gt.dPhy(4).and.dPhy(4).gt.0. _d 0) then
1315 C print*,'QQQ dphy2 > dphy4',i,j,k,Phy2(i,j,k),
1316 C & Phy4(i,j,k), dPhy(2), dPhy(4)
1317 C endif
1318 C if (Phy2(i,j,k).gt.Phy4(i,j,k).and.
1319 C & Phy4(i,j,k).gt.0. _d 0) then
1320 C print*,'QQ phy02 > phy04',i,j,k,Phy2(i,j,k),
1321 C & Phy4(i,j,k), dPhy(2), dPhy(4)
1322 C endif
1323
1324 if (dPhy(np2).gt.dPhy(np4).and.dPhy(np4).gt.0. _d 0) then
1325 print*,'QQQ dphy',np2,' > dphy',np4,i,j,k,Phy2(i,j,k),
1326 & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1327 endif
1328 if (Ptr(i,j,k,bi,bj,iphy+np2-1).gt.Ptr(i,j,k,bi,bj,iPhy+np4-1)
1329 & .and. Ptr(i,j,k,bi,bj,iPhy+np4-1).gt.0. _d 0) then
1330 print*,'QQ phy',np2,' > ',np4,i,j,k,
1331 & Ptr(i,j,k,bi,bj,iPhy+np2-1),
1332 & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1333 endif
1334
1335 endif
1336 enddo ! np
1337 endif ! k
1338 endif
1339 #endif
1340
1341 #ifdef ALLOW_DIAGNOSTICS
1342 COJ for diagnostics
1343 PParr(i,j,k) = PP
1344 Nfixarr(i,j,k) = Nfix
1345 c ANNA_TAVE
1346 #ifdef WAVES_DIAG_PCHL
1347 DO np = 1,npmax
1348 Pchlarr(i,j,k,np) = phychl(np)
1349 ENDDO
1350 #endif
1351 c ANNA end TAVE
1352 #ifdef DAR_DIAG_RSTAR
1353 DO np = 1,npmax
1354 Rstararr(i,j,k,np) = Rstarl(np)
1355 ENDDO
1356 #endif
1357 #ifdef ALLOW_DIAZ
1358 #ifdef DAR_DIAG_NFIXP
1359 DO np = 1,npmax
1360 NfixParr(i,j,k,np) = NfixPl(np)
1361 ENDDO
1362 #endif
1363 #endif
1364 #ifdef DAR_DIAG_CHL
1365 GeiderChlarr(i,j,k) = ChlGeiderlocal
1366 DoneyChlarr(i,j,k) = ChlDoneylocal
1367 CloernChlarr(i,j,k) = ChlCloernlocal
1368 IF (totphyC .NE. 0. _d 0) THEN
1369 GeiderChl2Carr(i,j,k) = ChlGeiderlocal/totphyC
1370 DoneyChl2Carr(i,j,k) = ChlDoneylocal/totphyC
1371 CloernChl2Carr(i,j,k) = ChlCloernlocal/totphyC
1372 ELSE
1373 GeiderChl2Carr(i,j,k) = 0. _d 0
1374 DoneyChl2Carr(i,j,k) = 0. _d 0
1375 CloernChl2Carr(i,j,k) = 0. _d 0
1376 ENDIF
1377 #endif
1378 COJ
1379 #endif /* ALLOW_DIAGNOSTICS */
1380
1381 c total fixation (NOTE - STILL NEEDS GLOB SUM)
1382 tot_Nfix=tot_Nfix+
1383 & Nfix*rA(i,j,bi,bj)*rF(k)*hFacC(i,j,k,bi,bj)
1384
1385 #ifdef ALLOW_TIMEAVE
1386 c save averages
1387 c Phygrow1ave(i,j,k,bi,bj)=Phygrow1ave(i,j,k,bi,bj)+
1388 c & mu1*py1*deltaTclock
1389 c & /float(nsubtime)
1390 c Phygrow2ave(i,j,k,bi,bj)=Phygrow2ave(i,j,k,bi,bj)+
1391 c & mu2*py2*deltaTclock
1392 c & /float(nsubtime)
1393 c Zoograzave(i,j,k,bi,bj)=Zoograzave(i,j,k,bi,bj)+
1394 c & (gampn1*graz1*zo +gampn2*graz2*zo)*
1395 c & deltaTclock/float(nsubtime)
1396 #ifdef GEIDER
1397 Chlave(i,j,k,bi,bj)=Chlave(i,j,k,bi,bj)+
1398 & Chl*dtplankton
1399 #endif
1400 PARave(i,j,k,bi,bj)=PARave(i,j,k,bi,bj)+
1401 & PARl*dtplankton
1402 PPave(i,j,k,bi,bj)=PPave(i,j,k,bi,bj)+
1403 & PP*dtplankton
1404 Nfixave(i,j,k,bi,bj)=Nfixave(i,j,k,bi,bj)+
1405 & Nfix*dtplankton
1406 Denitave(i,j,k,bi,bj)=Denitave(i,j,k,bi,bj)+
1407 & denit*dtplankton
1408 #ifdef WAVES_DIAG_PCHL
1409 do np=1,npmax
1410 Pchlave(i,j,k,bi,bj,np)=Pchlave(i,j,k,bi,bj,np)+
1411 & phychl(np)*dtplankton
1412 enddo
1413 #endif
1414 #ifdef DAR_DIAG_PARW
1415 do ilam=1,tlam
1416 PARwave(i,j,k,bi,bj,ilam)=PARwave(i,j,k,bi,bj,ilam)+
1417 & PARw_k(ilam,k)*dtplankton
1418 enddo
1419 do np=1,npmax
1420 chl2cave(i,j,k,bi,bj,np)=chl2cave(i,j,k,bi,bj,np)+
1421 & chl2cl(np)*dtplankton
1422 enddo
1423 #endif
1424 #ifdef DAR_DIAG_ACDOM
1425 c print*,'acdom',k,acdom_k(k,darwin_diag_acdom_ilam)
1426 aCDOMave(i,j,k,bi,bj)=aCDOMave(i,j,k,bi,bj)+
1427 & acdom_k(k,darwin_diag_acdom_ilam)*dtplankton
1428 #endif
1429 #ifdef DAR_DIAG_IRR
1430 do ilam = 1,tlam
1431 if (k.EQ.1) then
1432 Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1433 & Edwsf(ilam)*dtplankton
1434 Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1435 & Eswsf(ilam)*dtplankton
1436 Coj no Eu at surface (yet)
1437 else
1438 Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1439 & Edz(ilam,k-1)*dtplankton
1440 Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1441 & Esz(ilam,k-1)*dtplankton
1442 Euave(i,j,k,bi,bj,ilam)=Euave(i,j,k,bi,bj,ilam)+
1443 & Euz(ilam,k-1)*dtplankton
1444 endif
1445 Estave(i,j,k,bi,bj,ilam)=Estave(i,j,k,bi,bj,ilam)+
1446 & Estop(ilam,k)*dtplankton
1447 Eutave(i,j,k,bi,bj,ilam)=Eutave(i,j,k,bi,bj,ilam)+
1448 & Eutop(ilam,k)*dtplankton
1449 enddo
1450 #endif
1451 #ifdef DAR_DIAG_IRR_AMPS
1452 do ilam = 1,tlam
1453 amp1ave(i,j,k,bi,bj,ilam)=amp1ave(i,j,k,bi,bj,ilam)+
1454 & amp1(ilam,k)*dtplankton
1455 amp2ave(i,j,k,bi,bj,ilam)=amp2ave(i,j,k,bi,bj,ilam)+
1456 & amp2(ilam,k)*dtplankton
1457 enddo
1458 #endif
1459 #ifdef DAR_DIAG_ABSORP
1460 do ilam = 1,tlam
1461 aave(i,j,k,bi,bj,ilam)=aave(i,j,k,bi,bj,ilam)+
1462 & a_k(k,ilam)*dtplankton
1463 enddo
1464 #endif
1465 #ifdef DAR_DIAG_SCATTER
1466 do ilam = 1,tlam
1467 btave(i,j,k,bi,bj,ilam)=btave(i,j,k,bi,bj,ilam)+
1468 & bt_k(k,ilam)*dtplankton
1469 bbave(i,j,k,bi,bj,ilam)=bbave(i,j,k,bi,bj,ilam)+
1470 & bb_k(k,ilam)*dtplankton
1471 enddo
1472 #endif
1473 #ifdef DAR_DIAG_PART_SCATTER
1474 do ilam = 1,tlam
1475 apartave(i,j,k,bi,bj,ilam)=apartave(i,j,k,bi,bj,ilam)+
1476 & apart_k(k,ilam)*dtplankton
1477 btpartave(i,j,k,bi,bj,ilam)=btpartave(i,j,k,bi,bj,ilam)+
1478 & bpart_k(k,ilam)*dtplankton
1479 bbpartave(i,j,k,bi,bj,ilam)=bbpartave(i,j,k,bi,bj,ilam)+
1480 & bbpart_k(k,ilam)*dtplankton
1481 enddo
1482 #endif
1483 #ifdef DAR_RADTRANS
1484 if (k.eq.1) then
1485 rmudave(i,j,bi,bj)=rmudave(i,j,bi,bj)+
1486 & rmud*dtplankton
1487 endif
1488 #endif
1489 #ifdef DAR_DIAG_EK
1490 do np=1,npmax
1491 Ekave(i,j,k,bi,bj,np)=Ekave(i,j,k,bi,bj,np)+
1492 & Ekl(np)*dtplankton
1493 EkoverEave(i,j,k,bi,bj,np)=EkoverEave(i,j,k,bi,bj,np)+
1494 & EkoverEl(np)*dtplankton
1495 acclimave(i,j,k,bi,bj,np)=acclimave(i,j,k,bi,bj,np)+
1496 & accliml(np)*dtplankton
1497 do ilam=1,tlam
1498 Ek_nlave(i,j,k,bi,bj,np,ilam)=
1499 & Ek_nlave(i,j,k,bi,bj,np,ilam)+
1500 & Ek_nll(np,ilam)*dtplankton
1501 EkoverE_nlave(i,j,k,bi,bj,np,ilam)=
1502 & EkoverE_nlave(i,j,k,bi,bj,np,ilam)+
1503 & EkoverE_nll(np,ilam)*dtplankton
1504 enddo
1505 enddo
1506 #endif
1507 #ifdef DAR_DIAG_RSTAR
1508 do np=1,npmax
1509 Rstarave(i,j,k,bi,bj,np)=Rstarave(i,j,k,bi,bj,np)+
1510 & Rstarl(np)*dtplankton
1511 RNstarave(i,j,k,bi,bj,np)=RNstarave(i,j,k,bi,bj,np)+
1512 & RNstarl(np)*dtplankton
1513 enddo
1514 #endif
1515 #ifdef DAR_DIAG_DIVER
1516 Diver1ave(i,j,k,bi,bj)=Diver1ave(i,j,k,bi,bj)+
1517 & Diver1(i,j,k)*dtplankton
1518 Diver2ave(i,j,k,bi,bj)=Diver2ave(i,j,k,bi,bj)+
1519 & Diver2(i,j,k)*dtplankton
1520 Diver3ave(i,j,k,bi,bj)=Diver3ave(i,j,k,bi,bj)+
1521 & Diver3(i,j,k)*dtplankton
1522 Diver4ave(i,j,k,bi,bj)=Diver4ave(i,j,k,bi,bj)+
1523 & Diver4(i,j,k)*dtplankton
1524 #endif
1525 #ifdef DAR_DIAG_GROW
1526 do np=1,npmax
1527 Growave(i,j,k,bi,bj,np)=Growave(i,j,k,bi,bj,np)+
1528 & Growl(np)*dtplankton
1529 Growsqave(i,j,k,bi,bj,np)=Growsqave(i,j,k,bi,bj,np)+
1530 & Growsql(np)*dtplankton
1531 enddo
1532 #endif
1533
1534 #ifdef ALLOW_DIAZ
1535 #ifdef DAR_DIAG_NFIXP
1536 do np=1,npmax
1537 NfixPave(i,j,k,bi,bj,np)=NfixPave(i,j,k,bi,bj,np)+
1538 & NfixPl(np)*dtplankton
1539 enddo
1540 #endif
1541 #endif
1542 #endif
1543
1544 #ifdef ALLOW_CARBON
1545 if (k.eq.1) then
1546 SURave(i,j,bi,bj) =SURave(i,j,bi,bj)+
1547 & flxCO2(i,j)*dtplankton
1548 SURCave(i,j,bi,bj) =SURCave(i,j,bi,bj)+
1549 & FluxCO2(i,j,bi,bj)*dtplankton
1550 SUROave(i,j,bi,bj) =SUROave(i,j,bi,bj)+
1551 & flxO2(i,j)*dtplankton
1552 pCO2ave(i,j,bi,bj) =pCO2ave(i,j,bi,bj)+
1553 & pCO2(i,j,bi,bj)*dtplankton
1554 pHave(i,j,bi,bj) =pHave(i,j,bi,bj)+
1555 & pH(i,j,bi,bj)*dtplankton
1556 endif
1557 #endif
1558 endif
1559 c end if hFac>0
1560
1561 enddo ! k
1562 c end layer loop
1563 c
1564
1565 ENDDO ! i
1566 ENDDO ! j
1567
1568 #ifdef ALLOW_PAR_DAY
1569 C 1 <-> 2
1570 PARiaccum = 3 - PARiprev
1571
1572 DO k=1,nR
1573 DO j=1,sNy
1574 DO i=1,sNx
1575 PARday(i,j,k,bi,bj,PARiaccum) =
1576 & PARday(i,j,k,bi,bj,PARiaccum) + PAR(i,j,k)
1577 ENDDO
1578 ENDDO
1579 ENDDO
1580
1581 phase = 0. _d 0
1582 itistime = DIFF_PHASE_MULTIPLE( phase, darwin_PARavPeriod,
1583 & newtime, dtsubtime)
1584
1585 IF ( itistime ) THEN
1586 C compute average
1587 nav = darwin_PARnav
1588 IF (newtime - baseTime .LT. darwin_PARavPeriod) THEN
1589 C incomplete period at beginning of run
1590 nav = NINT((newtime-baseTime)/dtsubtime)
1591 ENDIF
1592 DO k=1,nR
1593 DO j=1,sNy
1594 DO i=1,sNx
1595 PARday(i,j,k,bi,bj,PARiaccum) =
1596 & PARday(i,j,k,bi,bj,PARiaccum) / nav
1597 ENDDO
1598 ENDDO
1599 ENDDO
1600 C reset the other slot for averaging
1601 DO k=1,nR
1602 DO j=1,sNy
1603 DO i=1,sNx
1604 PARday(i,j,k,bi,bj,PARiprev) = 0. _d 0
1605 ENDDO
1606 ENDDO
1607 ENDDO
1608 ENDIF
1609 C itistime
1610 #endif
1611
1612 #ifdef DAR_CHECK_IRR_CONT
1613 i = myXGlobalLo-1+(bi-1)*sNx+idiscEs
1614 j = myYGlobalLo-1+(bj-1)*sNy+jdiscEs
1615 write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Es disc',
1616 & i,j,kdiscEs,ldiscEs,discEs
1617 i = myXGlobalLo-1+(bi-1)*sNx+idiscEu
1618 j = myYGlobalLo-1+(bj-1)*sNy+jdiscEu
1619 write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Eu disc',
1620 & i,j,kdiscEu,ldiscEu,discEu
1621 #endif
1622
1623 COJ fill diagnostics
1624 #ifdef ALLOW_DIAGNOSTICS
1625 IF ( useDiagnostics ) THEN
1626 diagname = ' '
1627 WRITE(diagname,'(A8)') 'PAR '
1628 CALL DIAGNOSTICS_FILL( PAR(1-Olx,1-Oly,1), diagname,
1629 & 0,Nr,2,bi,bj,myThid )
1630 WRITE(diagname,'(A8)') 'PP '
1631 CALL DIAGNOSTICS_FILL( PParr(1-Olx,1-Oly,1), diagname,
1632 & 0,Nr,2,bi,bj,myThid )
1633 WRITE(diagname,'(A8)') 'Nfix '
1634 CALL DIAGNOSTICS_FILL( Nfixarr(1-Olx,1-Oly,1), diagname,
1635 & 0,Nr,2,bi,bj,myThid )
1636 c ANNA_TAVE
1637 #ifdef WAVES_DIAG_PCHL
1638 DO np=1,MIN(99,npmax)
1639 WRITE(diagname,'(A5,I2.2,A1)') 'Pchl',np,' '
1640 CALL DIAGNOSTICS_FILL( Pchlarr(1-Olx,1-Oly,1,np), diagname,
1641 & 0,Nr,2,bi,bj,myThid )
1642 ENDDO
1643 #endif
1644 c ANNA end TAVE
1645 #ifdef DAR_DIAG_RSTAR
1646 DO np=1,MIN(99,npmax)
1647 WRITE(diagname,'(A5,I2.2,A1)') 'Rstar',np,' '
1648 CALL DIAGNOSTICS_FILL( Rstararr(1-Olx,1-Oly,1,np), diagname,
1649 & 0,Nr,2,bi,bj,myThid )
1650 ENDDO
1651 #endif
1652 #ifdef DAR_DIAG_DIVER
1653 WRITE(diagname,'(A8)') 'Diver1 '
1654 CALL DIAGNOSTICS_FILL( Diver1(1-Olx,1-Oly,1), diagname,
1655 & 0,Nr,2,bi,bj,myThid )
1656 WRITE(diagname,'(A8)') 'Diver2 '
1657 CALL DIAGNOSTICS_FILL( Diver2(1-Olx,1-Oly,1), diagname,
1658 & 0,Nr,2,bi,bj,myThid )
1659 WRITE(diagname,'(A8)') 'Diver3 '
1660 CALL DIAGNOSTICS_FILL( Diver3(1-Olx,1-Oly,1), diagname,
1661 & 0,Nr,2,bi,bj,myThid )
1662 WRITE(diagname,'(A8)') 'Diver4 '
1663 CALL DIAGNOSTICS_FILL( Diver4(1-Olx,1-Oly,1), diagname,
1664 & 0,Nr,2,bi,bj,myThid )
1665 WRITE(diagname,'(A8)') 'Shannon '
1666 CALL DIAGNOSTICS_FILL( Shannon(1-Olx,1-Oly,1), diagname,
1667 & 0,Nr,2,bi,bj,myThid )
1668 WRITE(diagname,'(A8)') 'Simpson '
1669 CALL DIAGNOSTICS_FILL( Simpson(1-Olx,1-Oly,1), diagname,
1670 & 0,Nr,2,bi,bj,myThid )
1671 #endif
1672 #ifdef ALLOW_DIAZ
1673 #ifdef DAR_DIAG_NFIXP
1674 DO np=1,MIN(99,npmax)
1675 WRITE(diagname,'(A5,I2.2,A1)') 'NfixP',np,' '
1676 CALL DIAGNOSTICS_FILL( NfixParr(1-Olx,1-Oly,1,np), diagname,
1677 & 0,Nr,2,bi,bj,myThid )
1678 ENDDO
1679 #endif
1680 #endif
1681 #ifdef DAR_DIAG_CHL
1682 CALL DIAGNOSTICS_FILL( GeiderChlarr(1-Olx,1-Oly,1), 'ChlGeide',
1683 & 0,Nr,2,bi,bj,myThid )
1684 CALL DIAGNOSTICS_FILL( GeiderChl2Carr(1-Olx,1-Oly,1),'Chl2CGei',
1685 & 0,Nr,2,bi,bj,myThid )
1686 CALL DIAGNOSTICS_FILL( DoneyChlarr(1-Olx,1-Oly,1), 'ChlDoney',
1687 & 0,Nr,2,bi,bj,myThid )
1688 CALL DIAGNOSTICS_FILL( DoneyChl2Carr(1-Olx,1-Oly,1), 'Chl2CDon',
1689 & 0,Nr,2,bi,bj,myThid )
1690 CALL DIAGNOSTICS_FILL( CloernChlarr(1-Olx,1-Oly,1), 'ChlCloer',
1691 & 0,Nr,2,bi,bj,myThid )
1692 CALL DIAGNOSTICS_FILL( CloernChl2Carr(1-Olx,1-Oly,1),'Chl2CClo',
1693 & 0,Nr,2,bi,bj,myThid )
1694 #endif
1695 #ifdef ALLOW_CARBON
1696 CALL DIAGNOSTICS_FILL( flxCO2(1-Olx,1-Oly), 'DICTFLX ',
1697 & 0,1,2,bi,bj,myThid )
1698 CALL DIAGNOSTICS_FILL( FluxCO2(1-Olx,1-Oly,bi,bj), 'DICCFLX ',
1699 & 0,1,2,bi,bj,myThid )
1700 CALL DIAGNOSTICS_FILL( flxO2(1-Olx,1-Oly), 'DICOFLX ',
1701 & 0,1,2,bi,bj,myThid )
1702 CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,bi,bj), 'DICPCO2 ',
1703 & 0,1,2,bi,bj,myThid )
1704 CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,bi,bj), 'DICPHAV ',
1705 & 0,1,2,bi,bj,myThid )
1706 #endif /* ALLOW_CARBON */
1707 ENDIF
1708 #endif /* ALLOW_DIAGNOSTICS */
1709 COJ
1710
1711 c determine iron partitioning - solve for free iron
1712 call darwin_fe_chem(bi,bj,iMin,iMax,jMin,jMax,
1713 & Ptr(1-OLx,1-OLy,1,bi,bj,iFeT), freefe,
1714 & myIter, mythid)
1715 c
1716 #ifdef ALLOW_TIMEAVE
1717 c save averages
1718 do k=1,nR
1719 dar_timeave(bi,bj,k)=dar_timeave(bi,bj,k)
1720 & +dtplankton
1721 #ifdef ALLOW_CARBON
1722 dic_timeave(bi,bj,k)=dic_timeave(bi,bj,k)
1723 & +dtplankton
1724 #endif
1725 enddo
1726 #endif
1727 c
1728 c -----------------------------------------------------
1729 ENDDO ! it
1730 c -----------------------------------------------------
1731 c end of bio-chemical time loop
1732 c
1733 RETURN
1734 END
1735 #endif /*MONOD*/
1736 #endif /*ALLOW_PTRACERS*/
1737
1738 C============================================================================

  ViewVC Help
Powered by ViewVC 1.1.22