/[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.13 - (hide annotations) (download)
Tue Oct 23 16:39:32 2012 UTC (12 years, 8 months ago) by stephd
Branch: MAIN
Changes since 1.12: +58 -1 lines
o add diagnostics for chl:c, Ek and Ek/E

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

  ViewVC Help
Powered by ViewVC 1.1.22