/[MITgcm]/MITgcm_contrib/ecco_darwin/v4_3deg/code/darwin_forcing.F
ViewVC logotype

Annotation of /MITgcm_contrib/ecco_darwin/v4_3deg/code/darwin_forcing.F

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


Revision 1.2 - (hide annotations) (download)
Mon Jan 27 06:31:50 2020 UTC (6 years, 7 months ago) by dimitri
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -1 lines
FILE REMOVED
where possible, using code and input files from va_llc270

1 dimitri 1.2 C $Header: /u/gcmpack/MITgcm_contrib/ecco_darwin/v4_3deg/code/darwin_forcing.F,v 1.1 2020/01/27 02:52:02 dimitri Exp $
2 dimitri 1.1 C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5     #include "PTRACERS_OPTIONS.h"
6     #include "DARWIN_OPTIONS.h"
7    
8     #ifdef ALLOW_PTRACERS
9     #ifdef ALLOW_DARWIN
10    
11     c=============================================================
12     c subroutine DARWIN_forcing
13     c step forward bio-chemical tracers in time
14     C==============================================================
15     SUBROUTINE DARWIN_Forcing(
16     U Ptr,
17     I bi,bj,imin,imax,jmin,jmax,
18     I myIter,myTime,myThid)
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "PARAMS.h"
22     #include "GRID.h"
23     #include "DYNVARS.h"
24     #ifdef USE_QSW
25     #include "FFIELDS.h"
26     #endif
27     #ifdef ALLOW_LONGSTEP
28     #include "LONGSTEP.h"
29     #endif
30     #include "PTRACERS_SIZE.h"
31     #include "PTRACERS_PARAMS.h"
32     #include "GCHEM.h"
33     #include "DARWIN_SIZE.h"
34     #include "DARWIN.h"
35     #include "DARWIN_IO.h"
36     #include "DARWIN_FLUX.h"
37     #include "DARWIN_FIELDS.h"
38     #include "GGL90.h"
39    
40     c ANNA include wavebands_params.h
41     #ifdef WAVEBANDS
42     #include "SPECTRAL_SIZE.h"
43     #include "SPECTRAL.h"
44     #include "WAVEBANDS_PARAMS.h"
45     #endif
46    
47    
48     C === Global variables ===
49     c tracers
50     _RL Ptr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy,nDarwin)
51     INTEGER bi,bj,imin,imax,jmin,jmax
52     INTEGER myIter
53     _RL myTime
54     INTEGER myThid
55    
56     C !FUNCTIONS:
57     C == Functions ==
58     #ifdef ALLOW_PAR_DAY
59     LOGICAL DIFF_PHASE_MULTIPLE
60     EXTERNAL DIFF_PHASE_MULTIPLE
61     #endif
62    
63     C============== Local variables ============================================
64     c plankton arrays
65     _RL ZooP(nzmax)
66     _RL ZooN(nzmax)
67     _RL ZooFe(nzmax)
68     _RL ZooSi(nzmax)
69     _RL Phy(npmax)
70     _RL Phy_k(npmax,Nr)
71     _RL Phyup(npmax)
72     _RL part_k(Nr)
73     c iron partitioning
74     _RL freefe(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
75     c some working variables
76     _RL sumpy
77     _RL sumpyup
78     c light variables
79     _RL PAR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
80     _RL sfac(1-OLy:sNy+OLy)
81     _RL atten,lite
82     _RL newtime ! for sub-timestepping
83     _RL runtim ! time from tracer initialization
84    
85    
86     c ANNA define variables for wavebands
87     #ifdef WAVEBANDS
88     integer ilam
89     _RL PARw_k(tlam,Nr)
90     _RL PARwup(tlam)
91     _RL acdom_k(Nr,tlam)
92     #ifdef DAR_RADTRANS
93     integer iday,iyr,imon,isec,lp,wd,mydate(4)
94     _RL Edwsf(tlam),Eswsf(tlam)
95     _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr),Eutop(tlam,Nr)
96     _RL tirrq(nr)
97     _RL tirrwq(tlam,nr)
98     _RL solz
99     _RL rmud
100     _RL actot,bctot,bbctot
101     _RL apart_k(Nr,tlam),bpart_k(Nr,tlam),bbpart_k(Nr,tlam)
102     _RL bt_k(Nr,tlam), bb_k(Nr,tlam)
103     #else
104     _RL PARwdn(tlam)
105     #endif
106     C always need for diagnostics
107     _RL a_k(Nr,tlam)
108     #endif /* WAVEBANDS */
109    
110    
111     #ifdef DAR_DIAG_DIVER
112     _RL Diver1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
113     _RL Diver2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
114     _RL Diver3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
115     _RL Diver4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
116    
117     _RL tmpphy(npmax)
118     _RL totphy, biotot, maxphy, phymax
119     #endif
120    
121     #ifdef GEIDER
122     _RL phychl(npmax)
123     _RL phychl_k(npmax,Nr)
124     #ifdef DYNAMIC_CHL
125     _RL dphychl(npmax)
126     _RL chlup(npmax)
127     #endif
128     #endif
129    
130     #ifdef ALLOW_DIAGNOSTICS
131     COJ for diagnostics
132     _RL PParr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
133     _RL Nfixarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
134     c ANNA_TAVE
135     #ifdef WAVES_DIAG_PCHL
136     _RL Pchlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
137     #endif
138     c ANNA end TAVE
139     #ifdef DAR_DIAG_RSTAR
140     _RL Rstararr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
141     #endif
142     #ifdef ALLOW_DIAZ
143     #ifdef DAR_DIAG_NFIXP
144     _RL NfixParr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,npmax)
145     #endif
146     #endif
147     #endif
148    
149    
150     _RL totphyC
151     #ifdef ALLOW_PAR_DAY
152     LOGICAL itistime
153     INTEGER PARiprev, PARiaccum, iperiod, nav
154     _RL phase
155     _RL dtsubtime
156     #endif
157     #ifdef DAR_DIAG_CHL
158     _RL ChlGeiderlocal, ChlDoneylocal, ChlCloernlocal
159     #ifdef ALLOW_DIAGNOSTICS
160     _RL GeiderChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
161     _RL GeiderChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
162     _RL DoneyChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
163     _RL DoneyChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
164     _RL CloernChlarr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
165     _RL CloernChl2Carr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
166     #endif
167     #endif
168     c
169     _RL freefu
170     _RL inputFel
171    
172     c some local variables
173     _RL PO4l
174     _RL NO3l
175     _RL FeTl
176     _RL Sil
177     _RL DOPl
178     _RL DONl
179     _RL DOFel
180     _RL POPl
181     _RL PONl
182     _RL POFel
183     _RL PSil
184     _RL POPupl
185     _RL PONupl
186     _RL POFeupl
187     _RL PSiupl
188     _RL Tlocal
189     _RL Slocal
190     _RL Qswlocal
191     _RL NH4l
192     _RL NO2l
193     _RL PARl
194     _RL dzlocal
195     _RL dz_k(Nr)
196     _RL dtplankton
197     _RL bottom
198     _RL PP
199     _RL Nfix
200     _RL denit
201     _RL Chl
202     _RL Rstarl(npmax)
203     _RL RNstarl(npmax)
204     #ifdef DAR_DIAG_GROW
205     _RL Growl(npmax)
206     _RL Growsql(npmax)
207     #endif
208     #ifdef ALLOW_DIAZ
209     #ifdef DAR_DIAG_NFIXP
210     _RL NfixPl(npmax)
211     #endif
212     #endif
213    
214     c local tendencies
215     _RL dphy(npmax)
216     _RL dzoop(nzmax)
217     _RL dzoon(nzmax)
218     _RL dzoofe(nzmax)
219     _RL dzoosi(nzmax)
220     _RL dPO4l
221     _RL dNO3l
222     _RL dFeTl
223     _RL dSil
224     _RL dDOPl
225     _RL dDONl
226     _RL dDOFel
227     _RL dPOPl
228     _RL dPONl
229     _RL dPOFel
230     _RL dPSil
231     _RL dNH4l
232     _RL dNO2l
233    
234     #ifdef ALLOW_CARBON
235     _RL dicl
236     _RL docl
237     _RL pocl
238     _RL picl
239     _RL alkl
240     _RL o2l
241     _RL ZooCl(nzmax)
242     _RL pocupl
243     _RL picupl
244     c tendencies
245     _RL ddicl
246     _RL ddocl
247     _RL dpocl
248     _RL dpicl
249     _RL dalkl
250     _RL do2l
251     _RL dZooCl(nzmax)
252     c air-sea fluxes
253     _RL flxCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
254     _RL flxALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
255     _RL flxO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
256    
257     _RL calcium(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
258     _RL KspTP(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
259     #ifdef ADKINS_SURF_FLUX
260     _RL dcal
261     #endif
262     #ifdef ALLOW_SED_DISS_FLUX
263     c sediment-to-ocean fluxes
264     _RL DICSedFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
265     _RL ALKSedFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
266     _RL BBLDiffusionCoeffLoc
267     _RL BBLThicknessLoc
268     _RL RFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
269     _RL CO3Sw(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
270     _RL CO3Sed(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
271     #endif /* ALLOW_SED_DISS_FLUX */
272    
273     _RL t
274     _RL s
275     _RL ta
276     _RL pt
277     _RL sit
278     _RL tk
279     _RL tk100
280     _RL tk1002
281     _RL dlogtk
282     _RL sqrtis
283     _RL sqrts
284     _RL s15
285     _RL scl
286     _RL x1
287     _RL x2
288     _RL s2
289     _RL xacc
290     _RL invtk
291     _RL is
292     _RL is2
293     _RL bdepth
294     _RL cdepth
295     _RL pressc
296     _RL Ksp_T_Calc
297     _RL xvalue
298     _RL zdum
299     _RL tmpa1
300     _RL tmpa2
301     _RL tmpa3
302     _RL logKspc
303     _RL dv
304     _RL dk
305     _RL pfactor
306     _RL bigR
307    
308     _RL pCO2SolverTemp
309     _RL pCO2SolverSal
310     _RL pCO2SolverDic
311     _RL pCO2SolverPo4
312     _RL pCO2SolverSi
313     _RL pCO2SolverAlk
314    
315     _RL baselinePH(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
316     _RL baselinePCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
317     _RL baselineCO3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
318    
319     #ifdef CO2_FLUX_BUDGET
320     _RL pHBudget1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
321     _RL pCO2Budget1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
322     _RL CO3Budget1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
323    
324     _RL pCO2Temp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
325     _RL pCO2Salt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
326     _RL pCO2Alk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
327     _RL pCO2Dic(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
328    
329     _RL deltaTemp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
330     _RL deltaSalt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
331     _RL deltaAlk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
332     _RL deltaDic(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
333     _RL deltaApCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
334    
335     _RL deltaDic_temp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
336     _RL deltaDic_salt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
337     _RL deltaDic_alk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
338     _RL deltaDic_apCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
339     _RL deltaDic_CO2Flux(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
340     _RL deltaDic_residual(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
341     _RL deltaDic_bio(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
342    
343     _RL mixingDepthKLev(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
344     _RL mixingDepth(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
345    
346     _RL dCO2Flux_temp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
347     _RL dCO2Flux_salt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
348     _RL dCO2Flux_alk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
349     _RL dCO2Flux_dic(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
350     _RL dCO2Flux_apCO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
351     _RL dCO2Flux_residual(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
352     _RL dCO2Flux_bio(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
353     _RL dCO2Flux_circ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
354     #endif /* CO2_FLUX_BUDGET */
355     #endif
356    
357     _RL tot_Nfix
358     _RL tmp
359     _RL phytmp, chltmp
360    
361     INTEGER i,j,k,it, ktmp
362     INTEGER np, nz, np2, npsave
363     INTEGER debug
364     CHARACTER*8 diagname
365    
366     DO j=1-OLy,sNy+OLy
367     DO i=1-OLx,sNx+OLx
368     do k=1,Nr
369     freefe(i,j,k)=0. _d 0
370     PAR(i,j,k) = 0. _d 0
371     #ifdef DAR_DIAG_DIVER
372     Diver1(i,j,k)=0. _d 0
373     Diver2(i,j,k)=0. _d 0
374     Diver3(i,j,k)=0. _d 0
375     Diver4(i,j,k)=0. _d 0
376     #endif
377    
378     #ifdef ALLOW_DIAGNOSTICS
379     COJ for diagnostics
380     PParr(i,j,k) = 0. _d 0
381     Nfixarr(i,j,k) = 0. _d 0
382     #ifdef DAR_DIAG_CHL
383     GeiderChlarr(i,j,k) = 0. _d 0
384     GeiderChl2Carr(i,j,k) = 0. _d 0
385     DoneyChlarr(i,j,k) = 0. _d 0
386     DoneyChl2Carr(i,j,k) = 0. _d 0
387     CloernChlarr(i,j,k) = 0. _d 0
388     CloernChl2Carr(i,j,k) = 0. _d 0
389     #endif
390     c ANNA_TAVE
391     #ifdef WAVES_DIAG_PCHL
392     DO np=1,npmax
393     Pchlarr(i,j,k,np) = 0. _d 0
394     ENDDO
395     #endif
396     c ANNA end TAVE
397     #ifdef DAR_DIAG_RSTAR
398     DO np=1,npmax
399     Rstararr(i,j,k,np) = 0. _d 0
400     ENDDO
401     #endif
402     COJ
403     #ifdef ALLOW_DIAZ
404     #ifdef DAR_DIAG_NFIXP
405     DO np=1,npmax
406     NfixParr(i,j,k,np) = 0. _d 0
407     ENDDO
408     #endif
409     #endif
410     #endif
411     enddo
412     ENDDO
413     ENDDO
414     c
415     c bio-chemical time loop
416     c--------------------------------------------------
417     DO it=1,nsubtime
418     c -------------------------------------------------
419     tot_Nfix=0. _d 0
420     COJ cannot use dfloat because of adjoint
421     COJ division will be double precision anyway because of dTtracerLev
422     newtime=myTime-dTtracerLev(1)+
423     & float(it)*dTtracerLev(1)/float(nsubtime)
424     c print*,'it ',it,newtime,nsubtime,myTime
425     runtim=myTime-float(PTRACERS_Iter0)*dTtracerLev(1)
426    
427     c determine iron partitioning - solve for free iron
428     c ---------------------------
429     call darwin_fe_chem(bi,bj,iMin,iMax,jMin,jMax,
430     & Ptr(1-OLx,1-OLy,1,bi,bj,iFeT), freefe,
431     & myIter, mythid)
432     c --------------------------
433     #ifdef ALLOW_CARBON
434    
435     #ifdef CO2_FLUX_BUDGET
436     C store values from previous timestep
437     DO j=jmin,jmax
438     DO i=imin,imax
439     pHBudget1(i,j) = pH(i,j,bi,bj)
440     pCO2Budget1(i,j) = pCO2(i,j,bi,bj)
441     CO3Budget1(i,j) = CO3(i,j,bi,bj)
442     ENDDO
443     ENDDO
444     #endif /* CO2_FLUX_BUDGET */
445    
446     C compute baseline pCO2 and air-sea CO2 flux
447     call dic_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
448     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
449     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
450     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
451     & flxCO2,
452     & bi,bj,imin,imax,jmin,jmax,
453     & myIter,myTime,myThid)
454    
455     C store values from current timestep as non-perturbed baseline
456     DO j=jmin,jmax
457     DO i=imin,imax
458     baselinePH(i,j) = pH(i,j,bi,bj)
459     baselinePCO2(i,j) = pCO2(i,j,bi,bj)
460     baselineCO3(i,j) = CO3(i,j,bi,bj)
461     ENDDO
462     ENDDO
463    
464     c air-sea flux of O2
465     call dic_o2_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iO2),
466     & flxO2,
467     & bi,bj,imin,imax,jmin,jmax,
468     & myIter,myTime,myThid)
469     c dilution of alkalinity
470     call dic_alk_surfforcing(Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
471     & flxALK,
472     & bi,bj,imin,imax,jmin,jmax,
473     & myIter,myTime,myThid)
474     #endif
475    
476    
477     c find light in each grid cell
478     c ---------------------------
479     c determine incident light
480     #ifndef READ_PAR
481     #ifndef USE_QSW
482     DO j=1-OLy,sNy+OLy
483     sfac(j)=0. _d 0
484     ENDDO
485     call darwin_insol(newTime,sfac,bj)
486     #endif /* not USE_QSW */
487     #endif /* not READ_PAR */
488    
489     #ifdef ALLOW_PAR_DAY
490     C find out which slot of PARday has previous day's average
491     dtsubtime = dTtracerLev(1)/float(nsubtime)
492     C running index of averaging period
493     C myTime has already been incremented in this iteration,
494     C go back half a substep to avoid roundoff problems
495     iperiod = FLOOR((newtime-0.5 _d 0*dtsubtime)
496     & /darwin_PARavPeriod)
497     C 0 -> 1, 1->2, 2->0, ...
498     PARiprev = MOD(iperiod, 2) + 1
499    
500     #ifdef ALLOW_DIAGNOSTICS
501     C always fill; this will be the same during PARavPeriod, but this
502     C way it won't blow up for weird diagnostics periods.
503     C we fill before updating, so the diag is the one used in this time
504     C step
505     IF ( useDiagnostics ) THEN
506     CALL DIAGNOSTICS_FILL(
507     & PARday(1-Olx,1-Oly,1,bi,bj,PARiprev),'PARday ',
508     & 0,Nr,2,bi,bj,myThid )
509     ENDIF
510     #endif
511     #endif /* ALLOW_PAR_DAY */
512    
513     #ifdef DAR_RADTRANS
514     #ifndef DAR_RADTRANS_USE_MODEL_CALENDAR
515     #ifdef ALLOW_CAL
516     C get current date and time of day: iyr/imon/iday+isec
517     CALL CAL_GETDATE( myIter, newtime, mydate, mythid )
518     CALL CAL_CONVDATE( mydate,iyr,imon,iday,isec,lp,wd,mythid )
519     #else
520     STOP 'need cal package or DAR_RADTRANS_USE_MODEL_CALENDAR'
521     #endif
522     #endif
523     #endif
524    
525     C.................................................................
526     C.................................................................
527    
528    
529     C ========================== i,j loops =================================
530     DO j=1,sNy
531     DO i=1,sNx
532    
533     c ------------ these are convenient ------------------------------------
534     DO k=1,Nr
535     part_k(k) = max(Ptr(i,j,k,bi,bj,iPOP),0. _d 0)
536     DO np = 1,npmax
537     Phy_k(np,k) = max(Ptr(i,j,k,bi,bj,iPhy+np-1),0. _d 0)
538     #ifdef GEIDER
539     #ifdef DYNAMIC_CHL
540     phychl_k(np,k) = max(Ptr(i,j,k,bi,bj,iChl+np-1),0. _d 0)
541     #else
542     phychl_k(np,k) = max(Chl_phy(i,j,k,bi,bj,np), 0. _d 0)
543     #endif
544     #endif
545     ENDDO
546     ENDDO
547    
548     c ------------ GET CDOM_k FOR WAVEBANDS_3D and RADTRANS ----------------
549     #ifdef WAVEBANDS
550     #if defined(DAR_CALC_ACDOM) || defined(DAR_RADTRANS)
551     call darwin_acdom(phychl_k,aphy_chl,aw,
552     O acdom_k,
553     I myThid)
554     #else
555     DO k=1,Nr
556     DO ilam = 1,tlam
557     acdom_k(k,ilam) = acdom(ilam)
558     ENDDO
559     ENDDO
560     #endif /* DAR_CALC_ACDOM or DAR_RADTRANS */
561     #endif /* WAVEBANDS */
562    
563     c ------------ GET INCIDENT NON-SPECTRAL LIGHT -------------------------
564     #if !(defined(WAVEBANDS) && defined(OASIM))
565     #ifdef READ_PAR
566    
567     lite = sur_par(i,j,bi,bj)
568    
569     #else /* not READ_PAR */
570     #ifdef USE_QSW
571    
572     #ifdef ALLOW_LONGSTEP
573     Qswlocal=LS_Qsw(i,j,bi,bj)
574     #else
575     Qswlocal=Qsw(i,j,bi,bj)
576     #endif
577     lite = -parfrac*Qswlocal*parconv*maskC(i,j,1,bi,bj)
578    
579     #else /* not USE_QSW */
580    
581     C convert W/m2 to uEin/s/m2
582     lite = sfac(j)*parconv*maskC(i,j,1,bi,bj)
583    
584     #endif /* not USE_QSW */
585     #endif /* not READ_PAR */
586    
587     c take ice coverage into account
588     c unless already done in seaice package
589     #if !(defined (ALLOW_SEAICE) && defined (USE_QSW))
590     lite = lite*(1. _d 0-fice(i,j,bi,bj))
591     #endif
592     #endif /* not(WAVEBANDS and OASIM) */
593    
594     c ------------ LIGHT ATTENUATION: --------------------------------------
595     #ifndef WAVEBANDS
596     c ------------ SINGLE-BAND ATTENUATION ---------------------------------
597     atten=0. _d 0
598     do k=1,Nr
599     if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
600     sumpyup = sumpy
601     sumpy = 0. _d 0
602     do np=1,npmax
603     #ifdef GEIDER
604     sumpy = sumpy + phychl_k(np,k)
605     #else
606     sumpy = sumpy + Phy_k(np,k)
607     #endif
608     enddo
609     atten= atten + (k0 + kc*sumpy)*5. _d -1*drF(k)
610     if (k.gt.1)then
611     atten = atten + (k0+kc*sumpyup)*5. _d -1*drF(k-1)
612     endif
613     PAR(i,j,k) = lite*exp(-atten)
614     endif
615     enddo
616    
617     #else /* WAVEBANDS */
618     #ifndef DAR_RADTRANS
619     c ------------ WAVEBANDS W/O RADTRANS ----------------------------------
620     do ilam = 1,tlam
621     #ifdef OASIM
622     c add direct and diffuse, convert to uEin/m2/s/nm
623     PARwup(ilam) = WtouEins(ilam)*(oasim_ed(i,j,ilam,bi,bj)+
624     & oasim_es(i,j,ilam,bi,bj))
625     c and take ice fraction into account
626     c PARwup(ilam) = PARwup(ilam)*(1 _d 0 - fice(i,j,bi,bj))
627     #else
628     c sf is per nm; convert to per waveband
629     PARwup(ilam) = wb_width(ilam)*sf(ilam)*lite
630     #endif
631     enddo
632    
633     do k=1,Nr
634     if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
635     do ilam = 1,tlam
636     sumpy = 0.
637     do np = 1,npmax
638     c get total attenuation (absorption) by phyto at each wavelength
639     sumpy = sumpy + (phychl_k(np,k)*aphy_chl(np,ilam))
640     enddo
641     c for diagnostic
642     a_k(k,ilam) = aw(ilam) + sumpy + acdom_k(k,ilam)
643     atten = a_k(k,ilam)*drF(k)
644     PARwdn(ilam) = PARwup(ilam)*exp(-atten)
645     enddo
646    
647     c find for the midpoint of the gridcell (gridcell mean)
648     do ilam = 1,tlam
649     C PARw_k(ilam,k)=exp((log(PARwup(ilam))+log(PARwdn(ilam)))*0.5)
650     PARw_k(ilam,k)=sqrt(PARwup(ilam)*PARwdn(ilam))
651     enddo
652    
653     c cycle
654     do ilam=1,tlam
655     PARwup(ilam) = PARwdn(ilam)
656     enddo
657     else
658     do ilam=1,tlam
659     PARw_k(ilam,k) = 0. _d 0
660     enddo
661     endif
662    
663     c sum wavebands for total PAR at the mid point of the gridcell (PARl)
664     PAR(i,j,k) = 0.
665     do ilam = 1,tlam
666     PAR(i,j,k) = PAR(i,j,k) + PARw_k(ilam,k)
667     enddo
668     enddo
669    
670     #else /* DAR_RADTRANS */
671     c ------------ FULL RADIATIVE TRANSFER CODE ----------------------------
672     do ilam = 1,tlam
673     Edwsf(ilam) = oasim_ed(i,j,ilam,bi,bj)
674     Eswsf(ilam) = oasim_es(i,j,ilam,bi,bj)
675     enddo
676    
677     #ifdef DAR_RADTRANS_USE_MODEL_CALENDAR
678     C simplified solar zenith angle for 360-day year and daily averaged light
679     C cos(solz) is average over daylight period
680     call darwin_solz360(newtime, YC(i,j,bi,bj),
681     O solz)
682    
683     #else /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
684     C use calendar date for full solar zenith angle computation
685     C Use local noon zenith angle to avoid problems with zero cosine and
686     C non-zero light. One should really use a zenith angle compatible with
687     C the light fields, in particular averaged over the same time period.
688     isec = MOD(36.*3600. - 240.*XC(i,j,bi,bj), 86400.)
689     call radtrans_sfcsolz(rad,iyr,imon,iday,isec,
690     I XC(i,j,bi,bj),YC(i,j,bi,bj),
691     O solz)
692     #endif /* not DAR_RADTRANS_USE_MODEL_CALENDAR */
693    
694     c have Ed,Es below surface - no need for this adjustment on Ed Es for surface affects
695     c do ilam=1,tlam
696     c rod(ilam) = 0.0 _d 0
697     c ros(ilam) = 0.0 _d 0
698     c enddo
699    
700     c compute 1/cos(zenith) for direct light below surface
701     call radtrans_sfcrmud(rad,solz,
702     O rmud)
703    
704     C compute absorption/scattering coefficients for radtrans
705     DO k=1,Nr
706     dz_k(k) = drF(k)*HFacC(i,j,k,bi,bj)
707     DO ilam = 1,tlam
708     c absorption by phyto
709     actot = 0.0
710     bctot = 0.0
711     bbctot = 0.0
712     DO np = 1,npmax
713     actot = actot + phychl_k(np,k)*aphy_chl(np,ilam)
714     bctot = bctot + phychl_k(np,k)*bphy_chl(np,ilam)
715     bbctot = bbctot + phychl_k(np,k)*bbphy_chl(np,ilam)
716     ENDDO
717     c particulate
718     apart_k(k,ilam) = part_k(k)*apart_P(ilam)
719     bpart_k(k,ilam) = part_k(k)*bpart_P(ilam)
720     bbpart_k(k,ilam) = part_k(k)*bbpart_P(ilam)
721     c add water and CDOM
722     a_k(k,ilam) = aw(ilam)+acdom_k(k,ilam)+actot+apart_k(k,ilam)
723     bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)
724     bb_k(k,ilam) = darwin_bbw*bw(ilam)+bbctot+bbpart_k(k,ilam)
725     bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))
726     ENDDO
727     ENDDO
728    
729     #ifdef DAR_RADTRANS_ITERATIVE
730     call darwin_radtrans_iter(
731     I dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
732     I darwin_radtrans_kmax,darwin_radtrans_niter,
733     O Edz,Esz,Euz,Eutop,
734     O tirrq,tirrwq,
735     I myThid)
736     #else
737     c dzlocal ?????
738     call darwin_radtrans(
739     I drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
740     O Edz,Esz,Euz,Eutop,
741     O tirrq,tirrwq,
742     I myThid)
743     #endif
744     c
745     c uses chl from prev timestep (as wavebands does)
746     c keep like this in case need to consider upwelling irradiance as affecting the grid box above
747     c will pass to plankton: PARw only, but will be for this timestep for RT and prev timestep for WAVBANDS
748     c
749     c now copy
750     DO k=1,Nr
751     PAR(i,j,k) = tirrq(k)
752     DO ilam = 1,tlam
753     PARw_k(ilam,k) = tirrwq(ilam,k)
754     ENDDO
755     ENDDO
756     #endif /* DAR_RADTRANS */
757    
758     c oj: ???
759     c so PARw and PARwup from WAVEBANDS_1D are from previous timestep (attenuation done in plankton)
760     c but PARw and PARwup from WAVEBANDS_3D and RADTRANS are for the current timestep
761    
762     #endif /* WAVEBANDS */
763    
764     C ============================ k loop ==================================
765     c for each layer ...
766     do k= 1, NR
767     if (HFacC(i,j,k,bi,bj).gt.0. _d 0) then
768    
769     c make sure we only deal with positive definite numbers
770     c brute force...
771     po4l = max(Ptr(i,j,k,bi,bj,iPO4 ),0. _d 0)
772     no3l = max(Ptr(i,j,k,bi,bj,iNO3 ),0. _d 0)
773     fetl = max(Ptr(i,j,k,bi,bj,iFeT ),0. _d 0)
774     sil = max(Ptr(i,j,k,bi,bj,iSi ),0. _d 0)
775     dopl = max(Ptr(i,j,k,bi,bj,iDOP ),0. _d 0)
776     donl = max(Ptr(i,j,k,bi,bj,iDON ),0. _d 0)
777     dofel = max(Ptr(i,j,k,bi,bj,iDOFe ),0. _d 0)
778     DO nz = 1,nzmax
779     ZooP(nz) = max(Ptr(i,j,k,bi,bj,iZooP (nz)),0. _d 0)
780     ZooN(nz) = max(Ptr(i,j,k,bi,bj,iZooN (nz)),0. _d 0)
781     ZooFe(nz) = max(Ptr(i,j,k,bi,bj,iZooFe(nz)),0. _d 0)
782     ZooSi(nz) = max(Ptr(i,j,k,bi,bj,iZooSi(nz)),0. _d 0)
783     ENDDO
784     popl = max(Ptr(i,j,k,bi,bj,iPOP ),0. _d 0)
785     ponl = max(Ptr(i,j,k,bi,bj,iPON ),0. _d 0)
786     pofel = max(Ptr(i,j,k,bi,bj,iPOFe ),0. _d 0)
787     psil = max(Ptr(i,j,k,bi,bj,iPOSi ),0. _d 0)
788     NH4l = max(Ptr(i,j,k,bi,bj,iNH4 ),0. _d 0)
789     NO2l = max(Ptr(i,j,k,bi,bj,iNO2 ),0. _d 0)
790     #ifdef ALLOW_CARBON
791     dicl = max(Ptr(i,j,k,bi,bj,iDIC ),0. _d 0)
792     docl = max(Ptr(i,j,k,bi,bj,iDOC ),0. _d 0)
793     pocl = max(Ptr(i,j,k,bi,bj,iPOC ),0. _d 0)
794     picl = max(Ptr(i,j,k,bi,bj,iPIC ),0. _d 0)
795     alkl = max(Ptr(i,j,k,bi,bj,iALK ),0. _d 0)
796     o2l = max(Ptr(i,j,k,bi,bj,iO2 ),0. _d 0)
797     cal = max(Ptr(i,j,k,bi,bj,iCa ),0. _d 0)
798    
799     DO nz = 1,nzmax
800     ZooCl(nz) = max(Ptr(i,j,k,bi,bj,iZooC (nz)),0. _d 0)
801     ENDDO
802     #endif
803    
804     totphyC = 0. _d 0
805     DO np=1,npmax
806     totphyC = totphyC + R_PC(np)*Ptr(i,j,k,bi,bj,iPhy+np-1)
807     ENDDO
808    
809     DO np = 1,npmax
810     Phy(np) = Phy_k(np,k)
811     #ifdef GEIDER
812     phychl(np) = phychl_k(np,k)
813     #endif
814     ENDDO
815    
816     #ifdef DAR_DIAG_DIVER
817     Diver1(i,j,k)=0. _d 0
818     Diver2(i,j,k)=0. _d 0
819     Diver3(i,j,k)=0. _d 0
820     Diver4(i,j,k)=0. _d 0
821     totphy=0. _d 0
822     do np=1,npmax
823     totphy=totphy + Phy(np)
824     tmpphy(np)=Phy(np)
825     enddo
826     if (totphy.gt.diver_thresh0) then
827     do np=1,npmax
828     c simple threshhold
829     if (Phy(np).gt.diver_thresh1) then
830     Diver1(i,j,k)=Diver1(i,j,k)+1. _d 0
831     endif
832     c proportion of total biomass
833     if (Phy(np)/totphy.gt.diver_thresh2) then
834     Diver2(i,j,k)=Diver2(i,j,k)+1. _d 0
835     endif
836     enddo
837     c majority of biomass by finding rank order
838     biotot=0. _d 0
839     do np2=1,npmax
840     phymax=0. _d 0
841     do np=1,npmax
842     if (tmpphy(np).gt.phymax) then
843     phymax=tmpphy(np)
844     npsave=np
845     endif
846     enddo
847     if (biotot.lt.totphy*diver_thresh3) then
848     Diver3(i,j,k)=Diver3(i,j,k)+1. _d 0
849     endif
850     biotot=biotot+tmpphy(npsave)
851     tmpphy(npsave)=0. _d 0
852     if (np2.eq.1) then
853     maxphy=phymax
854     endif
855     enddo
856     c ratio of maximum species
857     do np=1,npmax
858     if (Phy(np).gt.diver_thresh4*maxphy) then
859     Diver4(i,j,k)=Diver4(i,j,k)+1. _d 0
860     endif
861     enddo
862     endif
863     #endif
864    
865     c..........................................................
866     c find local light
867     c..........................................................
868    
869     PARl = PAR(i,j,k)
870     c..........................................................
871    
872     c for explicit sinking of particulate matter and phytoplankton
873     if (k.eq.1) then
874     popupl =0. _d 0
875     ponupl =0. _d 0
876     pofeupl = 0. _d 0
877     psiupl = 0. _d 0
878     do np=1,npmax
879     Phyup(np)=0. _d 0
880     #ifdef DYNAMIC_CHL
881     chlup(np)=0. _d 0
882     #endif
883     enddo
884     #ifdef ALLOW_CARBON
885     pocupl = 0. _d 0
886     picupl = 0. _d 0
887     #endif
888     endif
889    
890     #ifdef ALLOW_LONGSTEP
891     Tlocal = LS_theta(i,j,k,bi,bj)
892     Slocal = LS_salt(i,j,k,bi,bj)
893     #else
894     Tlocal = theta(i,j,k,bi,bj)
895     Slocal = salt(i,j,k,bi,bj)
896     #endif
897    
898     freefu = max(freefe(i,j,k),0. _d 0)
899     if (k.eq.1) then
900     inputFel = inputFe(i,j,bi,bj)
901     else
902     inputFel = 0. _d 0
903     endif
904    
905     dzlocal = drF(k)*HFacC(i,j,k,bi,bj)
906     c set bottom=1.0 if the layer below is not ocean
907     ktmp=min(nR,k+1)
908     if(hFacC(i,j,ktmp,bi,bj).eq.0. _d 0.or.k.eq.Nr) then
909     bottom = 1.0 _d 0
910     else
911     bottom = 0.0 _d 0
912     endif
913    
914     c set tendencies to 0
915     do np=1,npmax
916     dphy(np)=0. _d 0
917     enddo
918     do nz=1,nzmax
919     dzoop(nz)=0. _d 0
920     dzoon(nz)=0. _d 0
921     dzoofe(nz)=0. _d 0
922     dzoosi(nz)=0. _d 0
923     enddo
924     dPO4l=0. _d 0
925     dNO3l=0. _d 0
926     dFeTl=0. _d 0
927     dSil=0. _d 0
928     dDOPl=0. _d 0
929     dDONl=0. _d 0
930     dDOFel=0. _d 0
931     dPOPl=0. _d 0
932     dPONl=0. _d 0
933     dPOFel=0. _d 0
934     dPSil=0. _d 0
935     dNH4l=0. _d 0
936     dNO2l=0. _d 0
937     #ifdef DYNAMIC_CHL
938     do np=1,npmax
939     dphychl(np)=0. _d 0
940     enddo
941     #endif
942     #ifdef ALLOW_CARBON
943     ddicl=0. _d 0
944     ddocl=0. _d 0
945     dpocl=0. _d 0
946     dpicl=0. _d 0
947     dalkl=0. _d 0
948     do2l=0. _d 0
949     do nz=1,nzmax
950     dzoocl(nz)=0. _d 0
951     enddo
952     #endif
953     dcal = 0. _d 0
954     c set other arguments to zero
955     PP=0. _d 0
956     Nfix=0. _d 0
957     denit=0. _d 0
958     do np=1,npmax
959     Rstarl(np)=0. _d 0
960     RNstarl(np)=0. _d 0
961     #ifdef DAR_DIAG_GROW
962     Growl(np)=0. _d 0
963     Growsql(np)=0. _d 0
964     #endif
965     #ifdef ALLOW_DIAZ
966     #ifdef DAR_DIAG_NFIXP
967     NfixPl(np)=0. _d 0
968     #endif
969     #endif
970     enddo
971    
972     c if (i.eq.20.and.j.eq.20.and.k.eq.1) debug=8
973     c if (i.eq.10.and.j.eq.10.and.k.eq.1) debug=100
974     c if (i.eq.1.and.j.eq.10.and.k.eq.1) debug=10
975     c if (i.eq.1.and.j.eq.1.and.k.eq.10) debug=14
976    
977     if (debug.eq.7) print*,'PO4, DOP, POP, ZooP',
978     & PO4l, DOPl, POPl, zooP
979     if (debug.eq.7) print*,'NO3, NO2, NH4, DON, PON, ZooN',
980     & NO3l,NO2l,NH4l, DONl, PONl, ZooN
981     if (debug.eq.7) print*,'FeT, DOFe, POFe, Zoofe',
982     & FeTl, DOFel, POFel, zooFe
983     if (debug.eq.7) print*,'Si, Psi, zooSi',
984     & Sil, PSil, zooSi
985     if (debug.eq.7) print*,'Total Phy', sumpy, PARl, lite
986     if (debug.eq.7) print*,'Phy', Phy
987    
988     if (debug.eq.8) print*,'k, PARl, inputFel, dzlocal',
989     & PARl, inputFel, dzlocal
990    
991     c if (NO3l.eq.0. _d 0.or.NO2l.eq.0. _d 0
992     c & .or.NH4l.eq.0. _d 0) then
993     c print*,'QQ N zeros',i,j,k,NO3l,NO2l,NH4l
994     c endif
995    
996     c compute Ksp as a function of temperature and pressure
997    
998     bdepth = 0.0d0
999     cdepth = 0.0d0
1000     pressc = 1.0d0
1001    
1002     do l = 1,k
1003     cdepth = bdepth + 0.5d0*drF(l)
1004     bdepth = bdepth + drF(l)
1005     pressc = 1.0d0 + 0.1d0*cdepth
1006     end do
1007    
1008     if (maskC(i,j,k,bi,bj).NE.0. _d 0) then
1009     t = Tlocal
1010     s = max(4. _d 0, Slocal)
1011    
1012     tk = 273.15 + t
1013     tk100 = tk/100.0
1014     tk1002=tk100*tk100
1015     invtk=1.0/tk
1016     dlogtk=log(tk)
1017     is=19.924*s/(1000.-1.005*s)
1018     is2=is*is
1019     sqrtis=sqrt(is)
1020     s2=s*s
1021     sqrts=sqrt(s)
1022     s15=s**1.5
1023     scl=s/1.80655
1024    
1025     c f = k0(1-pH2O)*correction term for non-ideality
1026     c Weiss & Price (1980, Mar. Chem., 8, 347-359; Eq 13 with table 6 values)
1027     ff(i,j,bi,bj) = exp(-162.8301 + 218.2968/tk100 +
1028     & 90.9241*log(tk100)-1.47696*tk1002 +
1029     & s*(0.025695-0.025225*tk100 +
1030     & 0.0049867*tk1002))
1031    
1032     c K0 from Weiss 1974
1033     ak0(i,j,bi,bj) = exp(93.4517/tk100-60.2409 +
1034     & 23.3585*log(tk100) +
1035     & s*(0.023517-0.023656*tk100 +
1036     & 0.0047036*tk1002))
1037    
1038     c k1 = [H][HCO3]/[H2CO3]
1039     c k2 = [H][CO3]/[HCO3]
1040     c Millero p.664 (1995) using Mehrbach et al. data on seawater scale
1041     ak1(i,j,bi,bj)=10**(-1*(3670.7*invtk -
1042     & 62.008+9.7944*dlogtk -
1043     & 0.0118*s+0.000116*s2))
1044    
1045     ak2(i,j,bi,bj)=10**(-1*(1394.7*invtk+4.777 -
1046     & 0.0184*s+0.000118*s2))
1047    
1048     c NOW PRESSURE DEPENDENCE:
1049     c Following Takahashi (1981) GEOSECS report - quoting Culberson and
1050     c Pytkowicz (1968)
1051     c pressc = pressure in bars
1052     ak1(i,j,bi,bj) = ak1(i,j,bi,bj) *
1053     & exp((24.2-0.085*t)*(pressc-1.0)/(83.143*tk))
1054    
1055     c FIRST GO FOR K2: According to GEOSECS (1982) report
1056     c ak2(i,j,bi,bj) = ak2(i,j,bi,bj) *
1057     c & exp((26.4-0.040*t)*(pressc-1.0)/(83.143*tk))
1058    
1059     c SECOND GO FOR K2: corrected coeff according to CO2sys documentation
1060     c E. Lewis and D. Wallace (1998) ORNL/CDIAC-105
1061     ak2(i,j,bi,bj) = ak2(i,j,bi,bj) *
1062     & exp((16.4-0.040*t)*(pressc-1.0)/(83.143*tk))
1063    
1064     c kb = [H][BO2]/[HBO2]
1065     c Millero p.669 (1995) using data from dickson (1990)
1066     akb(i,j,bi,bj)=exp((-8966.90-2890.53*sqrts-77.942*s +
1067     & 1.728*s15-0.0996*s2)*invtk +
1068     & (148.0248+137.1942*sqrts+1.62142*s) +
1069     & (-24.4344-25.085*sqrts-0.2474*s) *
1070     & dlogtk+0.053105*sqrts*tk)
1071    
1072     c Mick and Karsten - Dec 04
1073     c ADDING pressure dependence based on Millero (1995), p675
1074     c with additional info from CO2sys documentation (E. Lewis and
1075     c D. Wallace, 1998 - see endnotes for commentary on Millero, 95)
1076     bigR = 83.145
1077     dv = -29.48+0.1622*t+2.608d-3*t*t
1078     dk = -2.84d-3
1079     pfactor = - (dv/(bigR*tk))*pressc
1080     & + (0.5*dk/(bigR*tk))*pressc*pressc
1081    
1082     akb(i,j,bi,bj) = akb(i,j,bi,bj)*exp(pfactor)
1083    
1084     c k1p = [H][H2PO4]/[H3PO4]
1085     c DOE(1994) eq 7.2.20 with footnote using data from Millero (1974)
1086     ak1p(i,j,bi,bj) = exp(-4576.752*invtk+115.525 -
1087     & 18.453*dlogtk +
1088     & (-106.736*invtk+0.69171)*sqrts +
1089     & (-0.65643*invtk-0.01844)*s)
1090    
1091     c k2p = [H][HPO4]/[H2PO4]
1092     c DOE(1994) eq 7.2.23 with footnote using data from Millero (1974))
1093     ak2p(i,j,bi,bj) = exp(-8814.715*invtk+172.0883 -
1094     & 27.927*dlogtk +
1095     & (-160.340*invtk+1.3566)*sqrts +
1096     & (0.37335*invtk-0.05778)*s)
1097    
1098     c k3p = [H][PO4]/[HPO4]
1099     c DOE(1994) eq 7.2.26 with footnote using data from Millero (1974)
1100     ak3p(i,j,bi,bj) = exp(-3070.75*invtk-18.141 +
1101     & (17.27039*invtk+2.81197) *
1102     & sqrts+(-44.99486*invtk-0.09984)*s)
1103    
1104     c ksi = [H][SiO(OH)3]/[Si(OH)4]
1105     c Millero p.671 (1995) using data from Yao and Millero (1995)
1106     aksi(i,j,bi,bj) = exp(-8904.2*invtk+117.385 -
1107     & 19.334*dlogtk +
1108     & (-458.79*invtk+3.5913)*sqrtis +
1109     & (188.74*invtk-1.5998)*is +
1110     & (-12.1652*invtk+0.07871)*is2 +
1111     & log(1.0-0.001005*s))
1112    
1113     c kw = [H][OH]
1114     c Millero p.670 (1995) using composite data
1115     akw(i,j,bi,bj) = exp(-13847.26*invtk+148.9652 -
1116     & 23.6521*dlogtk +
1117     & (118.67*invtk-5.977+1.0495*dlogtk) *
1118     & sqrts-0.01615*s)
1119    
1120     c ks = [H][SO4]/[HSO4]
1121     c dickson (1990, J. chem. Thermodynamics 22, 113)
1122     aks(i,j,bi,bj)=exp(-4276.1*invtk+141.328 -
1123     & 23.093*dlogtk +
1124     & (-13856*invtk+324.57-47.986*dlogtk)*sqrtis +
1125     & (35474*invtk-771.54+114.723*dlogtk)*is -
1126     & 2698*invtk*is**1.5+1776*invtk*is2 +
1127     & log(1.0-0.001005*s))
1128    
1129     c kf = [H][F]/[HF]
1130     c dickson and Riley (1979) -- change pH scale to total
1131     akf(i,j,bi,bj)=exp(1590.2*invtk-12.641+1.525*sqrtis +
1132     & log(1.0-0.001005*s) +
1133     & log(1.0+(0.1400/96.062)*(scl)/aks(i,j,bi,bj)))
1134    
1135     c Calculate concentrations for borate, sulfate, and fluoride
1136     c Uppstrom (1974)
1137     bt(i,j,bi,bj) = 0.000232*scl/10.811
1138    
1139     c Morris & Riley (1966)
1140     st(i,j,bi,bj) = 0.14*scl/96.062
1141    
1142     c Riley (1965)
1143     ft(i,j,bi,bj) = 0.000067*scl/18.9984
1144    
1145     c solubility product for calcite
1146     C Following Mucci (1983) - from Zeebe/Wolf-Gladrow equic.m
1147     tmpa1 = -171.9065-(0.077993*tk)+(2839.319/tk) +
1148     & (71.595*log10(tk))
1149    
1150     tmpa2 = +(-0.77712+(0.0028426*tk)+(178.34/tk))*sqrts
1151     tmpa3 = -(0.07711*s)+(0.0041249*s15)
1152     logKspc = tmpa1+tmpa2+tmpa3
1153     Ksp_T_Calc = 10.0**logKspc
1154    
1155     c alternative pressure dependence from Ingle (1975)
1156     zdum = (pressc*10.0d0-10.0d0)/10.0d0
1157     xvalue = ((48.8d0-0.53d0*t)*zdum +
1158     & (-0.00588d0+0.0001845d0*t)*zdum*zdum) /
1159     & (188.93d0*(t+273.15d0))
1160    
1161     KspTP(i,j,bi,bj) = Ksp_T_Calc*10**(xvalue)
1162    
1163     else
1164     ff(i,j,bi,bj)=0.d0
1165     ak0(i,j,bi,bj)= 0.d0
1166     ak1(i,j,bi,bj)= 0.d0
1167     ak2(i,j,bi,bj)= 0.d0
1168     akb(i,j,bi,bj)= 0.d0
1169     ak1p(i,j,bi,bj) = 0.d0
1170     ak2p(i,j,bi,bj) = 0.d0
1171     ak3p(i,j,bi,bj) = 0.d0
1172     aksi(i,j,bi,bj) = 0.d0
1173     akw(i,j,bi,bj) = 0.d0
1174     aks(i,j,bi,bj)= 0.d0
1175     akf(i,j,bi,bj)= 0.d0
1176     bt(i,j,bi,bj) = 0.d0
1177     st(i,j,bi,bj) = 0.d0
1178     ft(i,j,bi,bj) = 0.d0
1179     KspTP(i,j,bi,bj) = 0.d0
1180     endif
1181    
1182     c compute CO3 for DARWIN_PLANKTON and sediment fluxes
1183     if (maskC(i,j,k,bi,bj).NE.0. _d 0) then
1184    
1185     pCO2SolverTemp = max(-4. _d 0, min(39. _d 0, Tlocal))
1186     pCO2SolverSal = max(4. _d 0, min(50. _d 0, Slocal))
1187    
1188     c check bounds for PCO2 solver
1189     pCO2SolverDic = max(100. _d 0, min(4000. _d 0,dicl))
1190     pCO2SolverAlk = max(100. _d 0, min(4000. _d 0,alkl))
1191     pCO2SolverPo4 = max(1. _d -10, min(10. _d 0,po4l))
1192     pCO2SolverSi = max(1. _d -8, min(500. _d 0,sil))
1193    
1194     c convert to mol m^-3
1195     pCO2SolverDic = pCO2SolverDic*1.0 _d -3
1196     pCO2SolverAlk = pCO2SolverAlk*1.0 _d -3
1197     pCO2SolverPo4 = pCO2SolverPo4*1.0 _d -3
1198     pCO2SolverSi = pCO2SolverSi*1.0 _d -3
1199    
1200     CALL CALC_PCO2_APPROX(
1201     I pCO2SolverTemp,pCO2SolverSal,
1202     I pCO2SolverDic,pCO2SolverPo4,
1203     I pCO2SolverSi,pCO2SolverAlk,
1204     I ak1(i,j,bi,bj),ak2(i,j,bi,bj),
1205     I ak1p(i,j,bi,bj),ak2p(i,j,bi,bj),ak3p(i,j,bi,bj),
1206     I aks(i,j,bi,bj),akb(i,j,bi,bj),akw(i,j,bi,bj),
1207     I aksi(i,j,bi,bj),akf(i,j,bi,bj),
1208     I ak0(i,j,bi,bj),fugf(i,j,bi,bj),
1209     I ff(i,j,bi,bj),
1210     I bt(i,j,bi,bj),st(i,j,bi,bj),ft(i,j,bi,bj),
1211     U pH(i,j,bi,bj),pCO2(i,j,bi,bj),CO3(i,j,bi,bj),
1212     I myThid)
1213    
1214     else
1215    
1216     pH(i,j,bi,bj) = 0. _d 0
1217     pCO2(i,j,bi,bj) = 0. _d 0
1218     CO3(i,j,bi,bj) = 0. _d 0
1219    
1220     endif
1221    
1222     #ifdef ADKINS_SURF_FLUX
1223     c include surface fluxes from forcing files, compute calcium tracer
1224     if (k.eq.1) then
1225     dcal = dcal + ((caSurf_flx(i,j,bi,bj) * 1. _d 3))
1226     endif
1227    
1228     dcal = dcal - budgetConsumpDIC_PIC(i,j,k,bi,bj) +
1229     & disscPIC(i,j,k,bi,bj)
1230    
1231     Ptr(i,j,k,bi,bj,iCA) = MAX(Ptr(i,j,k,bi,bj,iCA) +
1232     & dtplankton*dcal,0. _d 0)
1233    
1234     calcium(i,j,k,bi,bj) = Ptr(i,j,k,bi,bj,iCa)
1235     #else
1236     C calcium in mmol m^-3
1237     calcium(i,j,k,bi,bj) = 1.028 _d -2*Slocal/35. _d 0
1238     & * 1. _d 3
1239     #endif /* ADKINS_SURF_FLUX */
1240    
1241     c ANNA pass extra variables if WAVEBANDS
1242     CALL DARWIN_PLANKTON(
1243     U Phy,
1244     I zooP, zooN, zooFe, zooSi,
1245     O PP, Chl, Nfix, denit,
1246     I PO4l, NO3l, FeTl, Sil,
1247     I NO2l, NH4l,
1248     I DOPl, DONl, DOFel,
1249     I POPl, PONl, POFel, PSil,
1250     I phyup, popupl, ponupl,
1251     I pofeupl, psiupl,
1252     I PARl,
1253     I Tlocal, Slocal,
1254     I freefu, inputFel,
1255     I bottom, dzlocal,
1256     O Rstarl, RNstarl,
1257     #ifdef DAR_DIAG_GROW
1258     O Growl, Growsql,
1259     #endif
1260     #ifdef ALLOW_DIAZ
1261     #ifdef DAR_DIAG_NFIXP
1262     O NfixPl,
1263     #endif
1264     #endif
1265     O dphy, dzooP, dzooN, dzooFe,
1266     O dzooSi,
1267     O dPO4l, dNO3l, dFeTl, dSil,
1268     O dNH4l, dNO2l,
1269     O dDOPl, dDONl, dDOFel,
1270     O dPOPl, dPONl, dPOFel, dPSil,
1271     #ifdef ALLOW_CARBON
1272     I dicl, docl, pocl, picl,
1273     I alkl, o2l, zoocl,
1274     I pocupl, picupl, KspTP(i,j,bi,bj),
1275     I CO3(i,j,bi,bj), calcium(i,j,k,bi,bj),
1276     O ddicl, ddocl, dpocl, dpicl,
1277     O dalkl, do2l, dzoocl, omegaC(i,j,k,bi,bj),
1278     O disscPIC(i,j,k,bi,bj),
1279     #endif
1280     O budgetConsumpDIC(i,j,k,bi,bj),
1281     O budgetConsumpDIC_PIC(i,j,k,bi,bj),
1282     O budgetPReminC(i,j,k,bi,bj),
1283     O budgetDOCRemin(i,j,k,bi,bj),
1284     #ifdef GEIDER
1285     O phychl,
1286     #ifdef DYNAMIC_CHL
1287     I dphychl,
1288     I chlup,
1289     #endif
1290     #ifdef WAVEBANDS
1291     I PARw_k(1,k),
1292     #endif
1293     #endif
1294     #ifdef ALLOW_PAR_DAY
1295     I PARday(i,j,k,bi,bj,PARiprev),
1296     #endif
1297     #ifdef DAR_DIAG_CHL
1298     O ChlGeiderlocal, ChlDoneylocal,
1299     O ChlCloernlocal,
1300     #endif
1301     I debug,
1302     I runtim,
1303     I MyThid)
1304    
1305     #ifdef IRON_SED_SOURCE
1306     c only above minimum depth (continental shelf)
1307     if (rF(k).gt.-depthfesed) then
1308     c only if bottom layer
1309     if (bottom.eq.1.0 _d 0) then
1310     #ifdef IRON_SED_SOURCE_VARIABLE
1311     c calculate sink of POP into bottom layer
1312     tmp=(wp_sink*POPupl)/(dzlocal)
1313     c convert to dPOCl
1314     dFetl=dFetl+fesedflux_pcm*(tmp*106. _d 0)
1315     #else
1316     dFetl=dFetl+fesedflux/
1317     & (drF(k)*hFacC(i,j,k,bi,bj))
1318     #endif
1319     endif
1320     endif
1321     #endif
1322     ponupl = PONl
1323     pofeupl = POFel
1324     psiupl = PSil
1325     do np=1,npmax
1326     Phyup(np) = Phy(np)
1327     #ifdef DYNAMIC_CHL
1328     chlup(np) = phychl(np)
1329     #endif
1330     enddo
1331    
1332     c
1333     #ifdef ALLOW_CARBON
1334     pocupl = POCl
1335     picupl = PICl
1336     c include surface forcing
1337     if (k.eq.1) then
1338     ddicl = ddicl + flxCO2(i,j)
1339     dalkl = dalkl + flxALK(i,j)
1340     do2l = do2l + flxO2(i,j)
1341     #ifdef ADKINS_SURF_FLUX
1342     c include surface fluxes from forcing files
1343     ddicl = ddicl + (dicSurf_flx(i,j,bi,bj) * 1. _d 3)
1344     dalkl = dalkl + (alkSurf_flx(i,j,bi,bj) * 1. _d 3)
1345     #endif /* ADKINS_SURF_FLUX */
1346     endif
1347     #ifdef ALLOW_SED_DISS_FLUX
1348     c compute sediment dissolution fluxes
1349     if (bottom.eq.1.0 _d 0) then
1350    
1351     CO3Sed(i,j,bi,bj) = (KspTP(i,j,bi,bj) /
1352     & calcium(i,j,k,bi,bj))
1353    
1354     BBLDiffusionCoeffLoc = 4.01 _d -10
1355    
1356     if (darwin_BBLFile .NE. ' ') then
1357     BBLThicknessLoc = BBLThickness(i,j,bi,bj)
1358     else
1359     BBLThicknessLoc = 1.0 _d -3
1360     endif
1361    
1362     CO3Sw(i,j,bi,bj) = CO3(i,j,bi,bj)
1363    
1364     c convert from mol kg^-1 to mol m^-3
1365     CO3Sed(i,j,bi,bj) = CO3Sed(i,j,bi,bj) * rhoConst
1366     CO3Sw(i,j,bi,bj) = CO3Sw(i,j,bi,bj) * rhoConst
1367    
1368     c compute flux in mol m^-3 s^-1
1369     RFlux(i,j,bi,bj) = (BBLDiffusionCoeffLoc /
1370     & BBLThicknessLoc) * (CO3Sed(i,j,bi,bj)-CO3Sw(i,j,bi,bj))
1371    
1372     c prevent negative fluxes (for now)
1373     if(RFlux(i,j,bi,bj).LT.0) then
1374     RFlux(i,j,bi,bj) = 0;
1375     endif
1376    
1377     DICSedFlux(i,j,bi,bj) = RFlux(i,j,bi,bj)
1378     ALKSedFlux(i,j,bi,bj) = 2*RFlux(i,j,bi,bj)
1379    
1380     c convert sediment fluxes to mmol m^-3 s^-1 and then add to local values
1381     ddicl = ddicl+(RFlux(i,j,bi,bj)*1.0 _d 3 /
1382     & drF(k)*HFacC(i,j,k,bi,bj))
1383     dalkl = dalkl+(2*RFlux(i,j,bi,bj)*1.0 _d 3 /
1384     & drF(k)*HFacC(i,j,k,bi,bj))
1385    
1386     endif
1387     #endif /* ALLOW_SED_DISS_F
1388     dno3l=0. _d 0
1389     dfetl=0. _d 0
1390     dsil=0. _d 0
1391     endif
1392     #endif
1393     #ifdef RELAX_NUTS
1394     #ifdef DENIT_RELAX
1395     if (rF(k).lt.-depthdenit) then
1396     if (darwin_relaxscale.gt.0. _d 0) then
1397     IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1398     c Fanny's formulation
1399     tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1400     if (tmp.gt.0. _d 0) then
1401     dno3l=dno3l-(tmp/
1402     & darwin_relaxscale)
1403     denit=tmp/
1404     & darwin_relaxscale
1405     else
1406     denit=0. _d 0
1407     endif
1408     c --- end fanny's formulation
1409     ENDIF
1410     c steph's alternativeLUX */
1411     #endif /* ALLOW_CARBON */
1412    
1413     #ifdef CONS_SUPP
1414     c only works for two layer model
1415     if (k.eq.2) then
1416     dpo4l=0. _d 0
1417     dno3l=0. _d 0
1418     dfetl=0. _d 0
1419     dsil=0. _d 0
1420     endif
1421     #endif
1422     #ifdef RELAX_NUTS
1423     #ifdef DENIT_RELAX
1424     if (rF(k).lt.-depthdenit) then
1425     if (darwin_relaxscale.gt.0. _d 0) then
1426     IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1427     c Fanny's formulation
1428     tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1429     if (tmp.gt.0. _d 0) then
1430     dno3l=dno3l-(tmp/
1431     & darwin_relaxscale)
1432     denit=tmp/
1433     & darwin_relaxscale
1434     else
1435     denit=0. _d 0
1436     endif
1437     c --- end fanny's formulation
1438     ENDIF
1439     c steph's alternative
1440     c tmp=(Ptr(i,j,k,bi,bj,iNO3 )-
1441     c & 16. _d 0 * Ptr(i,j,k,bi,bj,iPO4 ))
1442     c if (tmp.gt.0. _d 0) then
1443     c dno3l=dno3l-(tmp/
1444     c & darwin_relaxscale)
1445     c denit=tmp/
1446     c & darwin_relaxscale
1447     c else
1448     c denit=0. _d 0
1449     c endif
1450     c ---- end steph's alternative
1451     endif
1452     endif
1453     #else
1454     if (darwin_relaxscale.gt.0. _d 0) then
1455     IF ( darwin_PO4_RelaxFile .NE. ' ' ) THEN
1456     tmp=(Ptr(i,j,k,bi,bj,iPO4 )-po4_obs(i,j,k,bi,bj))
1457     if (tmp.lt.0. _d 0) then
1458     dpo4l=dpo4l-(tmp/
1459     & darwin_relaxscale)
1460     endif
1461     ENDIF
1462     IF ( darwin_NO3_RelaxFile .NE. ' ' ) THEN
1463     tmp=(Ptr(i,j,k,bi,bj,iNO3 )-no3_obs(i,j,k,bi,bj))
1464     if (tmp.lt.0. _d 0) then
1465     dno3l=dno3l-(tmp/
1466     & darwin_relaxscale)
1467     endif
1468     ENDIF
1469     IF ( darwin_Fet_RelaxFile .NE. ' ' ) THEN
1470     tmp=(Ptr(i,j,k,bi,bj,iFeT )-fet_obs(i,j,k,bi,bj))
1471     if (tmp.lt.0. _d 0) then
1472     dfetl=dfetl-(tmp/
1473     & darwin_relaxscale)
1474     endif
1475     ENDIF
1476     IF ( darwin_Si_RelaxFile .NE. ' ' ) THEN
1477     tmp=( Ptr(i,j,k,bi,bj,iSi )-si_obs(i,j,k,bi,bj))
1478     if (tmp.lt.0. _d 0) then
1479     dsil=dsil-(tmp/
1480     & darwin_relaxscale)
1481     endif
1482     ENDIF
1483     endif
1484     #endif
1485     #endif
1486     #ifdef FLUX_NUTS
1487     dpo4l=dpo4l+po4_flx(i,j,k,bi,bj)
1488     dno3l=dno3l+no3_flx(i,j,k,bi,bj)
1489     dfetl=dfetl+fet_flx(i,j,k,bi,bj)
1490     dsil=dsil+si_flx(i,j,k,bi,bj)
1491     #endif
1492    
1493     #ifdef ALLOW_OBCS
1494     IF (useOBCS) THEN
1495     dpo4l = dpo4l *maskInC(i,j,bi,bj)
1496     dno3l = dno3l *maskInC(i,j,bi,bj)
1497     dfetl = dfetl *maskInC(i,j,bi,bj)
1498     dsil = dsil *maskInC(i,j,bi,bj)
1499     ddopl = ddopl *maskInC(i,j,bi,bj)
1500     ddonl = ddonl *maskInC(i,j,bi,bj)
1501     ddofel = ddofel*maskInC(i,j,bi,bj)
1502     dpopl = dpopl *maskInC(i,j,bi,bj)
1503     dponl = dponl *maskInC(i,j,bi,bj)
1504     dpofel = dpofel*maskInC(i,j,bi,bj)
1505     dpsil = dpsil *maskInC(i,j,bi,bj)
1506     dnh4l = dnh4l *maskInC(i,j,bi,bj)
1507     dno2l = dno2l *maskInC(i,j,bi,bj)
1508     DO nz = 1,nzmax
1509     dzoop (nz) = dzoop (nz)*maskInC(i,j,bi,bj)
1510     dzoon (nz) = dzoon (nz)*maskInC(i,j,bi,bj)
1511     dzoofe(nz) = dzoofe(nz)*maskInC(i,j,bi,bj)
1512     dzoosi(nz) = dzoosi(nz)*maskInC(i,j,bi,bj)
1513     ENDDO
1514     DO np = 1,npmax
1515     dPhy(np) = dPhy(np)*maskInC(i,j,bi,bj)
1516     #ifdef GEIDER
1517     #ifdef DYNAMIC_CHL
1518     dphychl(np) = dphychl(np)*maskInC(i,j,bi,bj)
1519     #endif
1520     #endif
1521     ENDDO
1522     #ifdef ALLOW_CARBON
1523     ddicl = ddicl*maskInC(i,j,bi,bj)
1524     ddocl = ddocl*maskInC(i,j,bi,bj)
1525     dpocl = dpocl*maskInC(i,j,bi,bj)
1526     dpicl = dpicl*maskInC(i,j,bi,bj)
1527     dalkl = dalkl*maskInC(i,j,bi,bj)
1528     do2l = do2l *maskInC(i,j,bi,bj)
1529     dcal = dcal *maskInC(i,j,bi,bj)
1530     DO nz = 1,nzmax
1531     dzoocl(nz) = dzoocl(nz)*maskInC(i,j,bi,bj)
1532     ENDDO
1533     #endif
1534     ENDIF
1535     #endif
1536    
1537     c now update main tracer arrays
1538     dtplankton = PTRACERS_dTLev(k)/float(nsubtime)
1539     Ptr(i,j,k,bi,bj,iPO4 ) = Ptr(i,j,k,bi,bj,iPO4) +
1540     & dtplankton*dpo4l
1541     Ptr(i,j,k,bi,bj,iNO3 ) = Ptr(i,j,k,bi,bj,iNO3) +
1542     & dtplankton*dno3l
1543     Ptr(i,j,k,bi,bj,iFeT ) = Ptr(i,j,k,bi,bj,iFeT) +
1544     & dtplankton*dfetl
1545     Ptr(i,j,k,bi,bj,iSi ) = Ptr(i,j,k,bi,bj,iSi ) +
1546     & dtplankton*dsil
1547     Ptr(i,j,k,bi,bj,iDOP ) = Ptr(i,j,k,bi,bj,iDOP) +
1548     & dtplankton*ddopl
1549     Ptr(i,j,k,bi,bj,iDON ) = Ptr(i,j,k,bi,bj,iDON) +
1550     & dtplankton*ddonl
1551     Ptr(i,j,k,bi,bj,iDOFe) = Ptr(i,j,k,bi,bj,iDOFe) +
1552     & dtplankton*ddofel
1553     Ptr(i,j,k,bi,bj,iPOP ) = Ptr(i,j,k,bi,bj,iPOP ) +
1554     & dtplankton*dpopl
1555     Ptr(i,j,k,bi,bj,iPON ) = Ptr(i,j,k,bi,bj,iPON ) +
1556     & dtplankton*dponl
1557     Ptr(i,j,k,bi,bj,iPOFe) = Ptr(i,j,k,bi,bj,iPOFe) +
1558     & dtplankton*dpofel
1559     Ptr(i,j,k,bi,bj,iPOSi) = Ptr(i,j,k,bi,bj,iPOSi) +
1560     & dtplankton*dpsil
1561     Ptr(i,j,k,bi,bj,iNH4 ) = Ptr(i,j,k,bi,bj,iNH4 ) +
1562     & dtplankton*dnh4l
1563     Ptr(i,j,k,bi,bj,iNO2 ) = Ptr(i,j,k,bi,bj,iNO2 ) +
1564     & dtplankton*dno2l
1565     DO nz = 1,nzmax
1566     Ptr(i,j,k,bi,bj,iZooP (nz)) = Ptr(i,j,k,bi,bj,iZooP (nz)) +
1567     & dtplankton*dzoop (nz)
1568     Ptr(i,j,k,bi,bj,iZooN (nz)) = Ptr(i,j,k,bi,bj,iZooN (nz)) +
1569     & dtplankton*dzoon (nz)
1570     Ptr(i,j,k,bi,bj,iZooFe(nz)) = Ptr(i,j,k,bi,bj,iZooFe(nz)) +
1571     & dtplankton*dzoofe(nz)
1572     Ptr(i,j,k,bi,bj,iZooSi(nz)) = Ptr(i,j,k,bi,bj,iZooSi(nz)) +
1573     & dtplankton*dzoosi(nz)
1574     ENDDO
1575     DO np = 1,npmax
1576     Ptr(i,j,k,bi,bj,iPhy+np-1) = Ptr(i,j,k,bi,bj,iPhy+np-1) +
1577     & dtplankton*dPhy(np)
1578     #ifdef GEIDER
1579     #ifdef DYNAMIC_CHL
1580     if (np.eq.1) Chl=0. _d 0
1581     Ptr(i,j,k,bi,bj,iChl+np-1) = Ptr(i,j,k,bi,bj,iChl+np-1) +
1582     & dtplankton*dphychl(np)
1583     c chltmp=Ptr(i,j,k,bi,bj,iChl+np-1)
1584     c phytmp=Ptr(i,j,k,bi,bj,iPhy+np-1)
1585     c Ptr(i,j,k,bi,bj,iChl+np-1)=
1586     c & max(chltmp,phytmp*R_PC(np)*chl2cmin(np))
1587     c if (np.eq.1.and.i.eq.1.and.j.eq.1.and.k.eq.1)
1588     c & print*,chltmp,phytmp,phytmp*R_PC(np)*chl2cmin(np),
1589     c & phytmp*R_PC(np)*chl2cmax(np)
1590     c in darwin_plankton this is stored for previous timestep. Reset here.
1591     Chl=Chl+Ptr(i,j,k,bi,bj,iChl+np-1)
1592     #else
1593     Chl_phy(i,j,k,bi,bj,np)=phychl(np)
1594     #endif
1595     #endif
1596     ENDDO
1597     #ifdef ALLOW_CARBON
1598    
1599     Ptr(i,j,k,bi,bj,iDIC ) = Ptr(i,j,k,bi,bj,iDIC ) +
1600     & dtplankton*ddicl
1601     Ptr(i,j,k,bi,bj,iDOC ) = Ptr(i,j,k,bi,bj,iDOC ) +
1602     & dtplankton*ddocl
1603     Ptr(i,j,k,bi,bj,iPOC ) = Ptr(i,j,k,bi,bj,iPOC ) +
1604     & dtplankton*dpocl
1605     Ptr(i,j,k,bi,bj,iPIC ) = Ptr(i,j,k,bi,bj,iPIC ) +
1606     & dtplankton*dpicl
1607     Ptr(i,j,k,bi,bj,iALK ) = Ptr(i,j,k,bi,bj,iALK ) +
1608     & dtplankton*dalkl
1609     Ptr(i,j,k,bi,bj,iO2 ) = Ptr(i,j,k,bi,bj,iO2 ) +
1610     & dtplankton*do2l
1611     DO nz = 1,nzmax
1612     Ptr(i,j,k,bi,bj,iZooC (nz)) = Ptr(i,j,k,bi,bj,iZooC (nz)) +
1613     & dtplankton*dzoocl (nz)
1614     ENDDO
1615     #endif
1616     c
1617     #ifdef ALLOW_MUTANTS
1618     cQQQQTEST
1619     if (debug.eq.11) then
1620     if (k.lt.8) then
1621     do np=1,60
1622     if(mod(np,4).eq. 1. _d 0)then
1623     np2=np+1
1624     np4=np+3
1625    
1626     Coj: couldn't test this part after change Phynp -> Ptr(...,iPhy+np-1)
1627     Coj: used to be many copies of this:
1628     C if (dPhy(2).gt.dPhy(4).and.dPhy(4).gt.0. _d 0) then
1629     C print*,'QQQ dphy2 > dphy4',i,j,k,Phy2(i,j,k),
1630     C & Phy4(i,j,k), dPhy(2), dPhy(4)
1631     C endif
1632     C if (Phy2(i,j,k).gt.Phy4(i,j,k).and.
1633     C & Phy4(i,j,k).gt.0. _d 0) then
1634     C print*,'QQ phy02 > phy04',i,j,k,Phy2(i,j,k),
1635     C & Phy4(i,j,k), dPhy(2), dPhy(4)
1636     C endif
1637    
1638     c if (dPhy(np2).gt.dPhy(np4).and.dPhy(np4).gt.0. _d 0) then
1639     c print*,'QQQ dphy',np2,' > dphy',np4,i,j,k,Phy2(i,j,k),
1640     c & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1641     endif
1642     c if (Ptr(i,j,k,bi,bj,iphy+np2-1).gt.Ptr(i,j,k,bi,bj,iPhy+np4-1)
1643     c & .and. Ptr(i,j,k,bi,bj,iPhy+np4-1).gt.0. _d 0) then
1644     c print*,'QQ phy',np2,' > ',np4,i,j,k,
1645     c & Ptr(i,j,k,bi,bj,iPhy+np2-1),
1646     c & Ptr(i,j,k,bi,bj,iPhy+np4-1), dPhy(2), dPhy(4)
1647     endif
1648    
1649     endif
1650     enddo ! np
1651     endif ! k
1652     endif
1653     #endif
1654    
1655     #ifdef ALLOW_DIAGNOSTICS
1656     COJ for diagnostics
1657     PParr(i,j,k) = PP
1658     Nfixarr(i,j,k) = Nfix
1659     c ANNA_TAVE
1660     #ifdef WAVES_DIAG_PCHL
1661     DO np = 1,npmax
1662     Pchlarr(i,j,k,np) = phychl(np)
1663     ENDDO
1664     #endif
1665     c ANNA end TAVE
1666     #ifdef DAR_DIAG_RSTAR
1667     DO np = 1,npmax
1668     Rstararr(i,j,k,np) = Rstarl(np)
1669     ENDDO
1670     #endif
1671     #ifdef ALLOW_DIAZ
1672     #ifdef DAR_DIAG_NFIXP
1673     DO np = 1,npmax
1674     NfixParr(i,j,k,np) = NfixPl(np)
1675     ENDDO
1676     #endif
1677     #endif
1678     #ifdef DAR_DIAG_CHL
1679     GeiderChlarr(i,j,k) = ChlGeiderlocal
1680     DoneyChlarr(i,j,k) = ChlDoneylocal
1681     CloernChlarr(i,j,k) = ChlCloernlocal
1682     IF (totphyC .NE. 0. _d 0) THEN
1683     GeiderChl2Carr(i,j,k) = ChlGeiderlocal/totphyC
1684     DoneyChl2Carr(i,j,k) = ChlDoneylocal/totphyC
1685     CloernChl2Carr(i,j,k) = ChlCloernlocal/totphyC
1686     ELSE
1687     GeiderChl2Carr(i,j,k) = 0. _d 0
1688     DoneyChl2Carr(i,j,k) = 0. _d 0
1689     CloernChl2Carr(i,j,k) = 0. _d 0
1690     ENDIF
1691     #endif
1692     COJ
1693     #endif /* ALLOW_DIAGNOSTICS */
1694    
1695     c total fixation (NOTE - STILL NEEDS GLOB SUM)
1696     tot_Nfix=tot_Nfix+
1697     & Nfix*rA(i,j,bi,bj)*rF(k)*hFacC(i,j,k,bi,bj)
1698    
1699     #ifdef ALLOW_TIMEAVE
1700     c save averages
1701     c Phygrow1ave(i,j,k,bi,bj)=Phygrow1ave(i,j,k,bi,bj)+
1702     c & mu1*py1*deltaTclock
1703     c & /float(nsubtime)
1704     c Phygrow2ave(i,j,k,bi,bj)=Phygrow2ave(i,j,k,bi,bj)+
1705     c & mu2*py2*deltaTclock
1706     c & /float(nsubtime)
1707     c Zoograzave(i,j,k,bi,bj)=Zoograzave(i,j,k,bi,bj)+
1708     c & (gampn1*graz1*zo +gampn2*graz2*zo)*
1709     c & deltaTclock/float(nsubtime)
1710     #ifdef GEIDER
1711     Chlave(i,j,k,bi,bj)=Chlave(i,j,k,bi,bj)+
1712     & Chl*dtplankton
1713     #endif
1714     PARave(i,j,k,bi,bj)=PARave(i,j,k,bi,bj)+
1715     & PARl*dtplankton
1716     PPave(i,j,k,bi,bj)=PPave(i,j,k,bi,bj)+
1717     & PP*dtplankton
1718     Nfixave(i,j,k,bi,bj)=Nfixave(i,j,k,bi,bj)+
1719     & Nfix*dtplankton
1720     Denitave(i,j,k,bi,bj)=Denitave(i,j,k,bi,bj)+
1721     & denit*dtplankton
1722     #ifdef WAVES_DIAG_PCHL
1723     do np=1,npmax
1724     Pchlave(i,j,k,bi,bj,np)=Pchlave(i,j,k,bi,bj,np)+
1725     & phychl(np)*dtplankton
1726     enddo
1727     #endif
1728     #ifdef DAR_DIAG_ACDOM
1729     c print*,'acdom',k,acdom_k(k,darwin_diag_acdom_ilam)
1730     aCDOMave(i,j,k,bi,bj)=aCDOMave(i,j,k,bi,bj)+
1731     & acdom_k(k,darwin_diag_acdom_ilam)*dtplankton
1732     #endif
1733     #ifdef DAR_DIAG_IRR
1734     do ilam = 1,tlam
1735     if (k.EQ.1) then
1736     Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1737     & Edwsf(ilam)*dtplankton
1738     Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1739     & Eswsf(ilam)*dtplankton
1740     Coj no Eu at surface (yet)
1741     else
1742     Edave(i,j,k,bi,bj,ilam)=Edave(i,j,k,bi,bj,ilam)+
1743     & Edz(ilam,k-1)*dtplankton
1744     Esave(i,j,k,bi,bj,ilam)=Esave(i,j,k,bi,bj,ilam)+
1745     & Esz(ilam,k-1)*dtplankton
1746     Euave(i,j,k,bi,bj,ilam)=Euave(i,j,k,bi,bj,ilam)+
1747     & Euz(ilam,k-1)*dtplankton
1748     endif
1749     Eutave(i,j,k,bi,bj,ilam)=Eutave(i,j,k,bi,bj,ilam)+
1750     & Eutop(ilam,k)*dtplankton
1751     enddo
1752     #endif
1753     #ifdef DAR_DIAG_ABSORP
1754     do ilam = 1,tlam
1755     aave(i,j,k,bi,bj,ilam)=aave(i,j,k,bi,bj,ilam)+
1756     & a_k(k,ilam)*dtplankton
1757     enddo
1758     #endif
1759     #ifdef DAR_DIAG_SCATTER
1760     do ilam = 1,tlam
1761     btave(i,j,k,bi,bj,ilam)=btave(i,j,k,bi,bj,ilam)+
1762     & bt_k(k,ilam)*dtplankton
1763     bbave(i,j,k,bi,bj,ilam)=bbave(i,j,k,bi,bj,ilam)+
1764     & bb_k(k,ilam)*dtplankton
1765     enddo
1766     #endif
1767     #ifdef DAR_DIAG_PART_SCATTER
1768     do ilam = 1,tlam
1769     apartave(i,j,k,bi,bj,ilam)=apartave(i,j,k,bi,bj,ilam)+
1770     & apart_k(k,ilam)*dtplankton
1771     btpartave(i,j,k,bi,bj,ilam)=btpartave(i,j,k,bi,bj,ilam)+
1772     & bpart_k(k,ilam)*dtplankton
1773     bbpartave(i,j,k,bi,bj,ilam)=bbpartave(i,j,k,bi,bj,ilam)+
1774     & bbpart_k(k,ilam)*dtplankton
1775     enddo
1776     #endif
1777     #ifdef DAR_DIAG_RSTAR
1778     do np=1,npmax
1779     Rstarave(i,j,k,bi,bj,np)=Rstarave(i,j,k,bi,bj,np)+
1780     & Rstarl(np)*dtplankton
1781     RNstarave(i,j,k,bi,bj,np)=RNstarave(i,j,k,bi,bj,np)+
1782     & RNstarl(np)*dtplankton
1783     enddo
1784     #endif
1785     #ifdef DAR_DIAG_DIVER
1786     Diver1ave(i,j,k,bi,bj)=Diver1ave(i,j,k,bi,bj)+
1787     & Diver1(i,j,k)*dtplankton
1788     Diver2ave(i,j,k,bi,bj)=Diver2ave(i,j,k,bi,bj)+
1789     & Diver2(i,j,k)*dtplankton
1790     Diver3ave(i,j,k,bi,bj)=Diver3ave(i,j,k,bi,bj)+
1791     & Diver3(i,j,k)*dtplankton
1792     Diver4ave(i,j,k,bi,bj)=Diver4ave(i,j,k,bi,bj)+
1793     & Diver4(i,j,k)*dtplankton
1794     #endif
1795     #ifdef DAR_DIAG_GROW
1796     do np=1,npmax
1797     Growave(i,j,k,bi,bj,np)=Growave(i,j,k,bi,bj,np)+
1798     & Growl(np)*dtplankton
1799     Growsqave(i,j,k,bi,bj,np)=Growsqave(i,j,k,bi,bj,np)+
1800     & Growsql(np)*dtplankton
1801     enddo
1802     #endif
1803    
1804     #ifdef ALLOW_DIAZ
1805     #ifdef DAR_DIAG_NFIXP
1806     do np=1,npmax
1807     NfixPave(i,j,k,bi,bj,np)=NfixPave(i,j,k,bi,bj,np)+
1808     & NfixPl(np)*dtplankton
1809     enddo
1810     #endif
1811     #endif
1812     #endif
1813    
1814     #ifdef ALLOW_CARBON
1815     if (k.eq.1) then
1816     SURave(i,j,bi,bj) =SURave(i,j,bi,bj)+
1817     & flxCO2(i,j)*dtplankton
1818     SURCave(i,j,bi,bj) =SURCave(i,j,bi,bj)+
1819     & FluxCO2(i,j,bi,bj)*dtplankton
1820     SUROave(i,j,bi,bj) =SUROave(i,j,bi,bj)+
1821     & flxO2(i,j)*dtplankton
1822     pCO2ave(i,j,bi,bj) =pCO2ave(i,j,bi,bj)+
1823     & pCO2(i,j,bi,bj)*dtplankton
1824     pHave(i,j,bi,bj) =pHave(i,j,bi,bj)+
1825     & pH(i,j,bi,bj)*dtplankton
1826     endif
1827     #endif
1828     endif
1829     c end if hFac>0
1830    
1831     enddo ! k
1832     c end layer loop
1833     c
1834     ENDDO ! i
1835     ENDDO ! j
1836    
1837     #ifdef CO2_FLUX_BUDGET
1838     C set pH to value from previous timestep
1839     DO j=jmin,jmax
1840     DO i=imin,imax
1841     pH(i,j,bi,bj) = pHBudget1(i,j)
1842     ENDDO
1843     ENDDO
1844    
1845     C deltaPCO2 due to temperature pertubation
1846     call dic_budgetTemp(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
1847     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
1848     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
1849     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
1850     & deltaTemp,bi,bj,imin,imax,jmin,jmax,
1851     & myIter,myTime,myThid)
1852    
1853     C set pH to value from previous timestep and store pCO2
1854     DO j=jmin,jmax
1855     DO i=imin,imax
1856     pH(i,j,bi,bj) = pHBudget1(i,j)
1857     pCO2Temp(i,j) = pCO2(i,j,bi,bj)
1858     ENDDO
1859     ENDDO
1860    
1861     C deltaPCO2 due to salinity perturbation
1862     call dic_budgetSalt(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
1863     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
1864     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
1865     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
1866     & deltaSalt,bi,bj,imin,imax,jmin,jmax,
1867     & myIter,myTime,myThid)
1868    
1869     C set pH to value from previous timestep and store pCO2
1870     DO j=jmin,jmax
1871     DO i=imin,imax
1872     pH(i,j,bi,bj) = pHBudget1(i,j)
1873     pCO2Salt(i,j) = pCO2(i,j,bi,bj)
1874     ENDDO
1875     ENDDO
1876    
1877     C deltaPCO2 due to alkalinity perturbation
1878     call dic_budgetAlk(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
1879     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
1880     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
1881     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
1882     & deltaAlk,bi,bj,imin,imax,jmin,jmax,
1883     & myIter,myTime,myThid)
1884    
1885     C set pH to value from previous timestep and store pCO2
1886     DO j=jmin,jmax
1887     DO i=imin,imax
1888     pH(i,j,bi,bj) = pHBudget1(i,j)
1889     pCO2Alk(i,j) = pCO2(i,j,bi,bj)
1890     ENDDO
1891     ENDDO
1892    
1893     C deltaPCO2 due to DIC perturbation
1894     call dic_budgetDic(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
1895     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
1896     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
1897     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
1898     & deltaDic,bi,bj,imin,imax,jmin,jmax,
1899     & myIter,myTime,myThid)
1900    
1901     C set pH to value from previous timestep and store pCO2
1902     DO j=jmin,jmax
1903     DO i=imin,imax
1904     pH(i,j,bi,bj) = pHBudget1(i,j)
1905     pCO2Dic(i,j) = pCO2(i,j,bi,bj)
1906     ENDDO
1907     ENDDO
1908    
1909     C compute deltaApCO2
1910     call dic_budgetApCO2(Ptr(1-OLx,1-OLy,1,bi,bj,iDIC),
1911     & Ptr(1-OLx,1-OLy,1,bi,bj,iALK),
1912     & Ptr(1-OLx,1-OLy,1,bi,bj,iPO4),
1913     & Ptr(1-OLx,1-OLy,1,bi,bj,iSi),
1914     & deltaApCO2,bi,bj,imin,imax,jmin,jmax,
1915     & myIter,myTime,myThid)
1916    
1917     C reset to baseline values
1918     DO j=jmin,jmax
1919     DO i=imin,imax
1920     pH(i,j,bi,bj) = baselinePH(i,j)
1921     pCO2(i,j,bi,bj) = baselinePCO2(i,j)
1922     CO3(i,j,bi,bj) = baselineCO3(i,j)
1923     ENDDO
1924     ENDDO
1925    
1926     DO j=jmin,jmax
1927     DO i=imin,imax
1928    
1929     IF ( maskC(i,j,kLev,bi,bj).NE.0. _d 0 ) THEN
1930    
1931     C compute delta DIC terms for each budget component (mol C m^-3)
1932     deltaDic_temp(i,j) =
1933     & (((pCO2Temp(i,j) - baselinePCO2(i,j)) /
1934     & budgetPert) /
1935     & ((pCO2Dic(i,j) - baselinePCO2(i,j)) /
1936     & budgetPert)) *
1937     & deltaTemp(i,j)
1938    
1939     deltaDic_salt(i,j) =
1940     & (((pCO2Salt(i,j) - baselinePCO2(i,j)) /
1941     & budgetPert) /
1942     & ((pCO2Dic(i,j) - baselinePCO2(i,j)) /
1943     & budgetPert)) *
1944     & deltaSalt(i,j)
1945    
1946     deltaDic_alk(i,j) =
1947     & (((pCO2Alk(i,j) - baselinePCO2(i,j)) /
1948     & budgetPert) /
1949     & ((pCO2Dic(i,j) - baselinePCO2(i,j)) /
1950     & budgetPert)) *
1951     & deltaAlk(i,j)
1952    
1953     deltaDic_apCO2(i,j) =
1954     & (budgetPert / (pCO2Dic(i,j) - baselinePCO2(i,j))) *
1955     & deltaApCO2(i,j)
1956    
1957     C dDIC due to air-sea CO2 flux
1958     deltaDic_CO2Flux(i,j) = (flxCO2(i,j) * deltaT) / 1.0 _d 3
1959    
1960     deltaDic_residual(i,j) = deltaDic(i,j) -
1961     & (deltaDic_temp(i,j) + deltaDic_salt(i,j) +
1962     & deltaDic_alk(i,j) + deltaDic_apCO2(i,j))
1963    
1964     else
1965    
1966     deltaDic_temp(i,j) = 0. _d 0
1967     deltaDic_salt(i,j) = 0. _d 0
1968     deltaDic_alk(i,j) = 0. _d 0
1969     deltaDic_apCO2(i,j) = 0. _d 0
1970     deltaDic_CO2Flux(i,j) = 0. _d 0
1971     deltaDic_residual(i,j) = 0. _d 0
1972    
1973     endif
1974    
1975     ENDDO
1976     ENDDO
1977    
1978     C find k index from mixed layer depth
1979     DO k=1,Nr
1980     DO j=jmin,jmax
1981     DO i=imin,imax
1982     if(hMixLayer(i,j,bi,bj) .GE.
1983     & ABS(rF(k))) then
1984     mixingDepthKLev(i,j) = k
1985     mixingDepth(i,j) = ABS(rF(k))
1986     endif
1987     ENDDO
1988     ENDDO
1989     ENDDO
1990    
1991     C find k index from maximum GGL90 mixing length,
1992     C use this as "mixing layer depth"
1993     C DO k=1,Nr
1994     C DO j=jmin,jmax
1995     C DO i=imin,imax
1996     C if(mixingLength(i,j,k,bi,bj) .EQ.
1997     C & MAXVAL(mixingLength(i,j,1:Nr,bi,bj))) then
1998     C mixingDepthKLev(i,j) = k
1999     C mixingDepth(i,j) = ABS(rF(k))
2000     C endif
2001     C ENDDO
2002     C ENDDO
2003     C ENDDO
2004    
2005     C vertically-integrate relevant biological DIC tendency terms
2006     C mmol C m^-3 s^-1
2007     DO j=jmin,jmax
2008     DO i=imin,imax
2009     deltaDic_bio(i,j) = 0.0 _d 0
2010     ENDDO
2011     ENDDO
2012     DO k=1,Nr
2013     DO j=jmin,jmax
2014     DO i=imin,imax
2015     if(k .LE. mixingDepthKLev(i,j)) then
2016     deltaDic_bio(i,j) = deltaDic_bio(i,j) +
2017     & (-(budgetConsumpDIC(i,j,k,bi,bj)) +
2018     & -(budgetConsumpDIC_PIC(i,j,k,bi,bj)) +
2019     & budgetDOCRemin(i,j,k,bi,bj) +
2020     & budgetPReminC(i,j,k,bi,bj) +
2021     & disscPIC(i,j,k,bi,bj)) *
2022     & drF(k) / mixingDepth(i,j) / 1000.0 _d 0
2023     endif
2024     ENDDO
2025     ENDDO
2026     ENDDO
2027    
2028     C compute CO2 flux budget terms (mol C m^-2 s^-1)
2029     DO j=jmin,jmax
2030     DO i=imin,imax
2031    
2032     C Dustin & Dimitri will discuss how to incorporate sea ice in budget later
2033     C With exception of pCO2, there is a question whether the Fice scaling is needed here
2034     dCO2Flux_temp(i,j) = deltaDic_temp(i,j) *
2035     & mixingDepth(i,j) / deltaT *
2036     & (1. _d 0 - FIce(i,j,bi,bj))
2037    
2038     dCO2Flux_salt(i,j) = deltaDic_salt(i,j) *
2039     & mixingDepth(i,j) / deltaT *
2040     & (1. _d 0 - FIce(i,j,bi,bj))
2041    
2042     dCO2Flux_alk(i,j) = deltaDic_alk(i,j) *
2043     & mixingDepth(i,j) / deltaT *
2044     & (1. _d 0 - FIce(i,j,bi,bj))
2045    
2046     dCO2Flux_apCO2(i,j) = deltaDic_apCO2(i,j) *
2047     & mixingDepth(i,j) / deltaT *
2048     & (1. _d 0 - FIce(i,j,bi,bj))
2049    
2050     dCO2Flux_residual(i,j) = deltaDic_residual(i,j) *
2051     & mixingDepth(i,j) / deltaT *
2052     & (1. _d 0 - FIce(i,j,bi,bj))
2053    
2054     dCO2Flux_bio(i,j) = deltaDic_bio(i,j) *
2055     & mixingDepth(i,j) *
2056     & (1. _d 0 - FIce(i,j,bi,bj))
2057    
2058     dCO2Flux_circ(i,j) =
2059     & dCO2Flux_residual(i,j) -
2060     & dCO2Flux_bio(i,j)
2061    
2062     ENDDO
2063     ENDDO
2064    
2065     if (budgetTStep1 .EQ. 0) then
2066     budgetTStep1 = 1;
2067     endif
2068    
2069     #endif /* CO2_FLUX_BUDGET */
2070    
2071     C reset to baseline values
2072     DO j=jmin,jmax
2073     DO i=imin,imax
2074     pH(i,j,bi,bj) = baselinePH(i,j)
2075     pCO2(i,j,bi,bj) = baselinePCO2(i,j)
2076     CO3(i,j,bi,bj) = baselineCO3(i,j)
2077     ENDDO
2078     ENDDO
2079    
2080     #ifdef ALLOW_PAR_DAY
2081     C 1 <-> 2
2082     PARiaccum = 3 - PARiprev
2083    
2084     DO k=1,nR
2085     DO j=1,sNy
2086     DO i=1,sNx
2087     PARday(i,j,k,bi,bj,PARiaccum) =
2088     & PARday(i,j,k,bi,bj,PARiaccum) + PAR(i,j,k)
2089     ENDDO
2090     ENDDO
2091     ENDDO
2092    
2093     phase = 0. _d 0
2094     itistime = DIFF_PHASE_MULTIPLE( phase, darwin_PARavPeriod,
2095     & newtime, dtsubtime)
2096    
2097     IF ( itistime ) THEN
2098     C compute average
2099     nav = darwin_PARnav
2100     IF (newtime - baseTime .LT. darwin_PARavPeriod) THEN
2101     C incomplete period at beginning of run
2102     nav = NINT((newtime-baseTime)/dtsubtime)
2103     ENDIF
2104     DO k=1,nR
2105     DO j=1,sNy
2106     DO i=1,sNx
2107     PARday(i,j,k,bi,bj,PARiaccum) =
2108     & PARday(i,j,k,bi,bj,PARiaccum) / nav
2109     ENDDO
2110     ENDDO
2111     ENDDO
2112     C reset the other slot for averaging
2113     DO k=1,nR
2114     DO j=1,sNy
2115     DO i=1,sNx
2116     PARday(i,j,k,bi,bj,PARiprev) = 0. _d 0
2117     ENDDO
2118     ENDDO
2119     ENDDO
2120     ENDIF
2121     C itistime
2122     #endif
2123    
2124     COJ fill diagnostics
2125     #ifdef ALLOW_DIAGNOSTICS
2126     IF ( useDiagnostics ) THEN
2127     diagname = ' '
2128     WRITE(diagname,'(A8)') 'PAR '
2129     CALL DIAGNOSTICS_FILL( PAR(1-Olx,1-Oly,1), diagname,
2130     & 0,Nr,2,bi,bj,myThid )
2131     WRITE(diagname,'(A8)') 'PP '
2132     CALL DIAGNOSTICS_FILL( PParr(1-Olx,1-Oly,1), diagname,
2133     & 0,Nr,2,bi,bj,myThid )
2134     WRITE(diagname,'(A8)') 'Nfix '
2135     CALL DIAGNOSTICS_FILL( Nfixarr(1-Olx,1-Oly,1), diagname,
2136     & 0,Nr,2,bi,bj,myThid )
2137     c ANNA_TAVE
2138     #ifdef WAVES_DIAG_PCHL
2139     DO np=1,MIN(99,npmax)
2140     WRITE(diagname,'(A5,I2.2,A1)') 'Pchl',np,' '
2141     CALL DIAGNOSTICS_FILL( Pchlarr(1-Olx,1-Oly,1,np), diagname,
2142     & 0,Nr,2,bi,bj,myThid )
2143     ENDDO
2144     #endif
2145     c ANNA end TAVE
2146     #ifdef DAR_DIAG_RSTAR
2147     DO np=1,MIN(99,npmax)
2148     WRITE(diagname,'(A5,I2.2,A1)') 'Rstar',np,' '
2149     CALL DIAGNOSTICS_FILL( Rstararr(1-Olx,1-Oly,1,np), diagname,
2150     & 0,Nr,2,bi,bj,myThid )
2151     ENDDO
2152     #endif
2153     #ifdef DAR_DIAG_DIVER
2154     WRITE(diagname,'(A8)') 'Diver1 '
2155     CALL DIAGNOSTICS_FILL( Diver1(1-Olx,1-Oly,1), diagname,
2156     & 0,Nr,2,bi,bj,myThid )
2157     WRITE(diagname,'(A8)') 'Diver2 '
2158     CALL DIAGNOSTICS_FILL( Diver2(1-Olx,1-Oly,1), diagname,
2159     & 0,Nr,2,bi,bj,myThid )
2160     WRITE(diagname,'(A8)') 'Diver3 '
2161     CALL DIAGNOSTICS_FILL( Diver3(1-Olx,1-Oly,1), diagname,
2162     & 0,Nr,2,bi,bj,myThid )
2163     WRITE(diagname,'(A8)') 'Diver4 '
2164     CALL DIAGNOSTICS_FILL( Diver4(1-Olx,1-Oly,1), diagname,
2165     & 0,Nr,2,bi,bj,myThid )
2166     #endif
2167     #ifdef ALLOW_DIAZ
2168     #ifdef DAR_DIAG_NFIXP
2169     DO np=1,MIN(99,npmax)
2170     WRITE(diagname,'(A5,I2.2,A1)') 'NfixP',np,' '
2171     CALL DIAGNOSTICS_FILL( NfixParr(1-Olx,1-Oly,1,np), diagname,
2172     & 0,Nr,2,bi,bj,myThid )
2173     ENDDO
2174     #endif
2175     #endif
2176     #ifdef DAR_DIAG_CHL
2177     CALL DIAGNOSTICS_FILL( GeiderChlarr(1-Olx,1-Oly,1), 'ChlGeide',
2178     & 0,Nr,2,bi,bj,myThid )
2179     CALL DIAGNOSTICS_FILL( GeiderChl2Carr(1-Olx,1-Oly,1),'Chl2CGei',
2180     & 0,Nr,2,bi,bj,myThid )
2181     CALL DIAGNOSTICS_FILL( DoneyChlarr(1-Olx,1-Oly,1), 'ChlDoney',
2182     & 0,Nr,2,bi,bj,myThid )
2183     CALL DIAGNOSTICS_FILL( DoneyChl2Carr(1-Olx,1-Oly,1), 'Chl2CDon',
2184     & 0,Nr,2,bi,bj,myThid )
2185     CALL DIAGNOSTICS_FILL( CloernChlarr(1-Olx,1-Oly,1), 'ChlCloer',
2186     & 0,Nr,2,bi,bj,myThid )
2187     CALL DIAGNOSTICS_FILL( CloernChl2Carr(1-Olx,1-Oly,1),'Chl2CClo',
2188     & 0,Nr,2,bi,bj,myThid )
2189     #endif
2190     #ifdef ALLOW_CARBON
2191     CALL DIAGNOSTICS_FILL( flxCO2(1-Olx,1-Oly), 'DICTFLX ',
2192     & 0,1,2,bi,bj,myThid )
2193     CALL DIAGNOSTICS_FILL( FluxCO2(1-Olx,1-Oly,bi,bj), 'DICCFLX ',
2194     & 0,1,2,bi,bj,myThid )
2195     CALL DIAGNOSTICS_FILL( flxO2(1-Olx,1-Oly), 'DICOFLX ',
2196     & 0,1,2,bi,bj,myThid )
2197     CALL DIAGNOSTICS_FILL( fugf(1-Olx,1-Oly,bi,bj), 'DICFGCO2',
2198     & 0,1,2,bi,bj,myThid )
2199     CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,bi,bj), 'DICPCO2 ',
2200     & 0,1,2,bi,bj,myThid )
2201     CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,bi,bj), 'DICPHAV ',
2202     & 0,1,2,bi,bj,myThid )
2203     CALL DIAGNOSTICS_FILL(KspTP(1-Olx,1-Oly,bi,bj), 'KSPTP ',
2204     & 0,1,2,bi,bj,myThid)
2205     CALL DIAGNOSTICS_FILL(calcium(1-Olx,1-Oly,1,bi,bj), 'CALCIUM ',
2206     & 0,Nr,2,bi,bj,myThid)
2207     CALL DIAGNOSTICS_FILL(omegaC(1-Olx,1-Oly,1,bi,bj), 'OMEGAC ',
2208     & 0,Nr,2,bi,bj,myThid)
2209     CALL DIAGNOSTICS_FILL(disscPIC(1-Olx,1-Oly,1,bi,bj), 'DISSC ',
2210     & 0,Nr,2,bi,bj,myThid)
2211     #ifdef ALLOW_SED_DISS_FLUX
2212     CALL DIAGNOSTICS_FILL(DICSedFlux(1-Olx,1-Oly,bi,bj), 'DICSFLX ',
2213     & 0,1,2,bi,bj,myThid)
2214     CALL DIAGNOSTICS_FILL(ALKSedFlux(1-Olx,1-Oly,bi,bj), 'ALKSFLX ',
2215     & 0,1,2,bi,bj,myThid)
2216     CALL DIAGNOSTICS_FILL(RFlux(1-Olx,1-Oly,bi,bj), 'RFLUX ',
2217     & 0,1,2,bi,bj,myThid)
2218     CALL DIAGNOSTICS_FILL(CO3Sw(1-Olx,1-Oly,bi,bj), 'CO3SW ',
2219     & 0,1,2,bi,bj,myThid)
2220     CALL DIAGNOSTICS_FILL(CO3Sed(1-Olx,1-Oly,bi,bj), 'CO3SED ',
2221     & 0,1,2,bi,bj,myThid)
2222     #endif /* ALLOW_SED_DISS_FLUX */
2223    
2224     #ifdef CO2_FLUX_BUDGET
2225     CALL DIAGNOSTICS_FILL(deltaDic(1-Olx,1-Oly),
2226     & 'DDIC ',0,1,2,bi,bj,myThid )
2227     CALL DIAGNOSTICS_FILL(deltaDic_temp(1-Olx,1-Oly),
2228     & 'DDICTEMP',0,1,2,bi,bj,myThid )
2229     CALL DIAGNOSTICS_FILL(deltaDic_salt(1-Olx,1-Oly),
2230     & 'DDICSALT',0,1,2,bi,bj,myThid )
2231     CALL DIAGNOSTICS_FILL(deltaDic_alk(1-Olx,1-Oly),
2232     & 'DDICALK ',0,1,2,bi,bj,myThid )
2233     CALL DIAGNOSTICS_FILL(deltaDic_apCO2(1-Olx,1-Oly),
2234     & 'DDICATM ',0,1,2,bi,bj,myThid )
2235     CALL DIAGNOSTICS_FILL(deltaDic_CO2Flux(1-Olx,1-Oly),
2236     & 'DDICFLX ',0,1,2,bi,bj,myThid )
2237     CALL DIAGNOSTICS_FILL(deltaDic_residual(1-Olx,1-Oly),
2238     & 'DDICRES ',0,1,2,bi,bj,myThid )
2239     CALL DIAGNOSTICS_FILL(dCO2Flux(1-Olx,1-Oly,bi,bj),
2240     & 'DCO2FLX ',0,1,2,bi,bj,myThid )
2241     CALL DIAGNOSTICS_FILL(dCO2Flux_temp(1-Olx,1-Oly),
2242     & 'DCO2FLXT',0,1,2,bi,bj,myThid)
2243     CALL DIAGNOSTICS_FILL(dCO2Flux_salt(1-Olx,1-Oly),
2244     & 'DCO2FLXS',0,1,2,bi,bj,myThid)
2245     CALL DIAGNOSTICS_FILL(dCO2Flux_alk(1-Olx,1-Oly),
2246     & 'DCO2FLXA',0,1,2,bi,bj,myThid)
2247     CALL DIAGNOSTICS_FILL(dCO2Flux_apCO2(1-Olx,1-Oly),
2248     & 'DCO2FLXC',0,1,2,bi,bj,myThid)
2249     CALL DIAGNOSTICS_FILL(dCO2Flux_residual(1-Olx,1-Oly),
2250     & 'DCO2FLXR',0,1,2,bi,bj,myThid)
2251     CALL DIAGNOSTICS_FILL(dCO2Flux_bio(1-Olx,1-Oly),
2252     & 'DCO2FLXB',0,1,2,bi,bj,myThid)
2253     CALL DIAGNOSTICS_FILL(dCO2Flux_circ(1-Olx,1-Oly),
2254     & 'DCO2FLXP',0,1,2,bi,bj,myThid)
2255     CALL DIAGNOSTICS_FILL(mixingDepth(1-Olx,1-Oly),
2256     & 'BCO2MIXD',0,1,2,bi,bj,myThid)
2257     #endif /* CO2_FLUX_BUDGET */
2258    
2259     #endif /* ALLOW_CARBON */
2260     ENDIF
2261     #endif /* ALLOW_DIAGNOSTICS */
2262     COJ
2263    
2264     c determine iron partitioning - solve for free iron
2265     call darwin_fe_chem(bi,bj,iMin,iMax,jMin,jMax,
2266     & Ptr(1-OLx,1-OLy,1,bi,bj,iFeT), freefe,
2267     & myIter, mythid)
2268     c
2269     #ifdef ALLOW_TIMEAVE
2270     c save averages
2271     dar_timeave(bi,bj) = dar_timeave(bi,bj) + dtplankton
2272     #ifdef ALLOW_CARBON
2273     dic_timeave(bi,bj) = dic_timeave(bi,bj) + dtplankton
2274     #endif
2275     #endif
2276     c
2277     c -----------------------------------------------------
2278     ENDDO ! it
2279     c -----------------------------------------------------
2280     c end of bio-chemical time loop
2281     c
2282     RETURN
2283     END
2284     #endif /*DARWIN*/
2285     #endif /*ALLOW_PTRACERS*/
2286    
2287     C============================================================================

  ViewVC Help
Powered by ViewVC 1.1.22