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

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

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


Revision 1.12 - (hide annotations) (download)
Fri Aug 24 19:45:36 2012 UTC (12 years, 11 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt63s_20120908, ctrb_darwin2_ckpt64_20121012
Changes since 1.11: +47 -9 lines
fix check of continuity

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

  ViewVC Help
Powered by ViewVC 1.1.22