/[MITgcm]/MITgcm/pkg/dic/bio_export.F
ViewVC logotype

Contents of /MITgcm/pkg/dic/bio_export.F

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


Revision 1.21 - (show annotations) (download)
Thu Dec 6 22:24:34 2007 UTC (16 years, 6 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n
Changes since 1.20: +21 -6 lines
o don't allow negative biological activity (even if the nutrients have
  become negative). Need new GCHEM_OPTIONS.h macro: #define DIC_NO_NEG.

1 C $Header: /u/gcmpack/MITgcm/pkg/dic/bio_export.F,v 1.20 2007/12/05 16:52:32 dfer Exp $
2 C $Name: $
3
4 #include "DIC_OPTIONS.h"
5 #include "GCHEM_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: BIO_EXPORT
9
10 C !INTERFACE: ==========================================================
11 SUBROUTINE BIO_EXPORT( PTR_PO4 ,
12 #ifdef ALLOW_FE
13 I PTR_FE,
14 #endif
15 I bioac,
16 I bi,bj,imin,imax,jmin,jmax,
17 I myIter,myTime,myThid)
18
19 c !DESCRIPTION:
20 C Calculate biological activity and export
21
22 C !USES: ===============================================================
23 IMPLICIT NONE
24 #include "SIZE.h"
25 #include "DYNVARS.h"
26 #include "EEPARAMS.h"
27 #include "PARAMS.h"
28 #include "GRID.h"
29 #include "DIC_ABIOTIC.h"
30 #include "DIC_BIOTIC.h"
31 #ifdef USE_QSW
32 #include "FFIELDS.h"
33 #endif
34
35 C !INPUT PARAMETERS: ===================================================
36 C myThid :: thread number
37 C myIter :: current timestep
38 C myTime :: current time
39 C PTR_PO4 :: phosphate tracer field
40 C PTR_FE :: iron tracer field
41 INTEGER myIter
42 _RL myTime
43 INTEGER myThid
44 _RL PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
45 #ifdef ALLOW_FE
46 _RL PTR_FE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
47 #endif
48 INTEGER imin, imax, jmin, jmax, bi, bj
49
50
51 C !OUTPUT PARAMETERS: ==================================================
52 C bioac :: biological productivity (will be split
53 C between export and dissolved pool)
54 _RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR)
55
56 #ifdef ALLOW_PTRACERS
57 #ifdef DIC_BIOTIC
58
59 C !LOCAL VARIABLES: ====================================================
60 C i,j,k :: loop indices
61 INTEGER I,J,k
62 _RL sfac(1-OLy:sNy+OLy)
63 _RL lit, atten
64 _RL nutlimit
65 _RL tmpfe, tmppo4
66 #ifdef AD_SAFE
67 _RL thx, thy, theps
68 #endif
69 CEOP
70
71
72 #ifndef READ_PAR
73 #ifndef USE_QSW
74 call insol(myTime,sfac,bj)
75 #endif
76 #endif
77 DO j=jmin,jmax
78 DO i=imin,imax
79 C Fortran-90
80 CRG C$TAF INIT bio_export = static, nlev
81 C FORTRAN-77 dynamic memory uses adstore adresto
82 CRG C$TAF INIT bio_export = memory
83 C FORTRAN-77 with know max of nlev
84 C$TAF INIT bio_export = static, 10
85 #ifdef READ_PAR
86 lit=PAR(i,j,bi,bj)
87 #elif (defined USE_QSW)
88 lit=-parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj)
89 #else
90 lit=sfac(j)
91 #endif
92
93 IF ( .NOT. QSW_underice ) THEN
94 c if using Qsw but not seaice/thsice or coupled, then
95 c ice fraction needs to be taken into account
96 lit=lit*(1. _d 0 - FIce(i,j,bi,bj))
97 ENDIF
98 c
99 DO k=1,nlev
100 C$TAF STORE lit = bio_export
101 atten=(k0*drF(k)*hFacC(i,j,k,bi,bj)*.5 _d 0)
102 if (k.gt.1) atten=atten+(k0*drF(k-1)
103 & *hFacC(i,j,k-1,bi,bj)*.5 _d 0)
104 lit=lit*exp(-atten)
105 IF (lit.LT.0. _d 0.OR.lit.GT.350. _d 0) THEN
106 print*,'QQ lit', lit
107 ENDIF
108
109 #ifdef DIC_NO_NEG
110 tmppo4=max(0. _d 0, PTR_PO4(i,j,k))
111 lit=max(0. _d 0,lit)
112 #else
113 tmppo4=PTR_PO4(i,j,k)
114 #endif
115
116 #ifdef ALLOW_FE
117 #ifdef DIC_NO_NEG
118 tmpfe=max(0. _d 0,PTR_FE(i,j,k))
119 #else
120 tmpfe=PTR_FE(i,j,k)
121 #endif
122 #ifdef AD_SAFE
123 thx = tmppo4/(tmppo4+KPO4)
124 thy = tmpfe/(tmpfe+KFE)
125 c thx = PTR_PO4(i,j,k)/(PTR_PO4(i,j,k)+KPO4)
126 c thy = PTR_FE(i,j,k)/(PTR_FE(i,j,k)+KFE)
127 theps = 1. _d -6
128 nutlimit= ( 1. _d 0 - tanh((thx-thy)/theps) ) * thx/2. _d 0
129 & +( 1. _d 0 + tanh((thx-thy)/theps) ) * thy/2. _d 0
130 #else
131 nutlimit= min(tmppo4/(tmppo4+KPO4),
132 & tmpfe/(tmpfe+KFE) )
133 #endif
134 #else
135 nutlimit= tmppo4/(tmppo4+KPO4)
136 #endif
137
138 bioac(i,j,k)=alpha(i,j,bi,bj)*
139 & lit/(lit+lit0)*maskC(i,j,k,bi,bj)*
140 & nutlimit
141 ENDDO
142 ENDDO
143 ENDDO
144 c
145 #endif
146 #endif
147 RETURN
148 END

  ViewVC Help
Powered by ViewVC 1.1.22