/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/dic_surfforcing_init.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/darwin/dic_surfforcing_init.F

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


Revision 1.7 - (hide annotations) (download)
Wed Dec 4 21:18:11 2013 UTC (12 years ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64r_20131210, ctrb_darwin2_ckpt64v_20140411, ctrb_darwin2_ckpt64t_20140202, ctrb_darwin2_ckpt64s_20140105, ctrb_darwin2_ckpt64u_20140308
Changes since 1.6: +0 -7 lines
remove call to offline_fields_load (no longer needed)

1 jahn 1.1 #include "CPP_OPTIONS.h"
2     #include "PTRACERS_OPTIONS.h"
3     #include "DARWIN_OPTIONS.h"
4    
5     #ifdef ALLOW_PTRACERS
6     #ifdef ALLOW_DARWIN
7    
8     #ifdef ALLOW_CARBON
9    
10     CBOP
11     C !ROUTINE: DIC_SURFFORCING_INIT
12    
13     C !INTERFACE: ==========================================================
14     SUBROUTINE DIC_SURFFORCING_INIT(
15     I myThid)
16    
17     C !DESCRIPTION:
18     C Calculate first guess of pH
19    
20     C !USES: ===============================================================
21     IMPLICIT NONE
22     #include "SIZE.h"
23     #include "DYNVARS.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26     #include "GRID.h"
27     #include "FFIELDS.h"
28     #include "PTRACERS_SIZE.h"
29     #include "PTRACERS_PARAMS.h"
30     #include "PTRACERS_FIELDS.h"
31     #include "DARWIN_SIZE.h"
32     #include "DARWIN_IO.h"
33     #include "DARWIN_FLUX.h"
34     #include "DIC_ATMOS.h"
35    
36     C !INPUT PARAMETERS: ===================================================
37     C myThid :: thread number
38     INTEGER myThid
39    
40    
41     C !LOCAL VARIABLES: ====================================================
42     INTEGER i,j, k, kLev, it
43     INTEGER intime0,intime1
44     _RL otime
45     _RL aWght,bWght,rdt
46     INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
47     C Number of iterations for pCO2 solvers...
48     C Solubility relation coefficients
49     C local variables for carbon chem
50     INTEGER iMin,iMax,jMin,jMax, bi, bj
51     _RL surfdic(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52     _RL surfalk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53     _RL surfphos(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54     _RL surfsi(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55     _RL surfsalt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56 stephd 1.3 _RL surftemp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57 jahn 1.1 INTEGER iprt,jprt
58     CHARACTER*(MAX_LEN_MBUF) msgBuf
59     INTEGER iUnit
60     CHARACTER*(MAX_LEN_FNAM) iName
61     integer ilo,ihi
62     integer ilnblnk,ifnblnk
63     external ilnblnk,ifnblnk
64     LOGICAL pH_isLoaded
65     CEOP
66    
67     cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
68    
69     kLev=1
70    
71     CALL DIC_ATMOS(0, startTime, nIter0, myThid )
72    
73     _BEGIN_MASTER(myThid)
74    
75     C set up coefficients for DIC chemistry
76     C define Schmidt no. coefficients for CO2
77     sca1 = 2073.1 _d 0
78     sca2 = -125.62 _d 0
79     sca3 = 3.6276 _d 0
80     sca4 = -0.043219 _d 0
81     C define Schmidt no. coefficients for O2
82     C based on Keeling et al [GBC, 12, 141, (1998)]
83     sox1 = 1638.0 _d 0
84     sox2 = -81.83 _d 0
85     sox3 = 1.483 _d 0
86     sox4 = -0.008004 _d 0
87    
88     C coefficients for determining saturation O2
89     oA0= 2.00907 _d 0
90     oA1= 3.22014 _d 0
91     oA2= 4.05010 _d 0
92     oA3= 4.94457 _d 0
93     oA4= -2.56847 _d -1
94     oA5= 3.88767 _d 0
95     oB0= -6.24523 _d -3
96     oB1= -7.37614 _d -3
97     oB2= -1.03410 _d -2
98     oB3= -8.17083 _d -3
99     oC0= -4.88682 _d -7
100     C Set other constant/flag
101    
102     #ifndef USE_ATMOSCO2
103    
104 stephd 1.3 #ifndef USE_EXFCO2
105 jahn 1.1 if (dic_int1.eq.2) then
106     call mdsfindunit( iUnit, mythid )
107     open(UNIT=iUnit,FILE='co2atmos.dat',STATUS='old')
108     do k=1,dic_int2
109     read(iUnit,*) co2atmos(k)
110     print*,'co2atmos',co2atmos(k)
111     enddo
112     close(iUnit)
113     endif
114    
115     if (dic_int1.eq.3) then
116     write(iName,'(A,I10.10)') 'dic_atmos.',nIter0
117     ilo = ifnblnk(iName)
118     ihi = ilnblnk(iName)
119     call mdsfindunit( iUnit, mythid )
120     open(UNIT=iUnit,FILE=iname(ilo:ihi),STATUS='old')
121     read(iUnit,*) total_atmos_carbon_ini,
122     & atpco2_ini
123     close(iUnit)
124     endif
125 stephd 1.3 #endif
126 jahn 1.1
127     #endif
128     _END_MASTER(myThid)
129    
130     ccccccccccccccccccccccccccccccccccccccccc
131     IF ( periodicExternalForcing ) THEN
132    
133    
134     rdt = 1. _d 0 / deltaTclock
135     nForcingPeriods = NINT(externForcingCycle/externForcingPeriod)
136     cswd QQ change for placement of chem forcing (ie. after timestep)
137     Imytm = NINT(startTime*rdt)
138     Ifprd = NINT(externForcingPeriod*rdt)
139     Ifcyc = NINT(externForcingCycle*rdt)
140     Iftm = MOD( Imytm+Ifcyc-Ifprd/2, Ifcyc)
141    
142     intime0 = 1 + INT(Iftm/Ifprd)
143     intime1 = 1 + MOD(intime0,nForcingPeriods)
144     c aWght = DFLOAT( Iftm-Ifprd*(intime0 - 1) ) / DFLOAT( Ifprd )
145     aWght = FLOAT( Iftm-Ifprd*(intime0 - 1) )
146     bWght = FLOAT( Ifprd )
147     aWght = aWght / bWght
148     bWght = 1. _d 0 - aWght
149    
150     _BARRIER
151     _BEGIN_MASTER(myThid)
152    
153     _END_MASTER(myThid)
154    
155     c end periodicExternalForcing
156     ENDIF
157    
158     C =================================================================
159    
160     jMin=1
161     jMax=sNy
162     iMin=1
163     iMax=sNx
164    
165     DO bj=myByLo(myThid),myByHi(myThid)
166     DO bi=myBxLo(myThid),myBxHi(myThid)
167     DO j=1-OLy,sNy+OLy
168     DO i=1-Olx,sNx+OLx
169 stephd 1.6 #ifdef pH_3D
170     DO k=1,Nr
171     pH(i,j,k,bi,bj) = 8. _d 0
172     ENDDO
173     #else
174 jahn 1.1 pH(i,j,bi,bj) = 8. _d 0
175 stephd 1.6 #endif
176 jahn 1.1 ENDDO
177     ENDDO
178     ENDDO
179     ENDDO
180    
181     DO bj=myByLo(myThid),myByHi(myThid)
182     DO bi=myBxLo(myThid),myBxHi(myThid)
183     DO j=1-OLy,sNy+OLy
184     DO i=1-OLx,sNx+OLx
185     ak0(i,j,bi,bj)=0. _d 0
186     ak1(i,j,bi,bj)=0. _d 0
187     ak2(i,j,bi,bj)=0. _d 0
188     akw(i,j,bi,bj)=0. _d 0
189     akb(i,j,bi,bj)=0. _d 0
190     akf(i,j,bi,bj)=0. _d 0
191     ak1p(i,j,bi,bj)=0. _d 0
192     ak2p(i,j,bi,bj)=0. _d 0
193     ak3p(i,j,bi,bj)=0. _d 0
194     aksi(i,j,bi,bj)=0. _d 0
195 stephd 1.2 fugf(i,j,bi,bj)=0. _d 0
196 jahn 1.1 ff(i,j,bi,bj)=0. _d 0
197     ft(i,j,bi,bj)=0. _d 0
198     st(i,j,bi,bj)=0. _d 0
199     bt(i,j,bi,bj)=0. _d 0
200     ENDDO
201     ENDDO
202     ENDDO
203     ENDDO
204    
205     pH_isLoaded = .FALSE.
206     IF ( nIter0.GT.PTRACERS_Iter0 ) THEN
207     C Read pH from a pickup file if needed
208     CALL DIC_READ_PICKUP(
209     O pH_isLoaded,
210     I nIter0, myThid )
211     ENDIF
212    
213     DO bj=myByLo(myThid),myByHi(myThid)
214     DO bi=myBxLo(myThid),myBxHi(myThid)
215    
216 stephd 1.6 #ifdef pH_3D
217     DO kLev=1,Nr
218     #endif
219 jahn 1.1 C determine inorganic carbon chem coefficients
220     DO j=jMin,jMax
221     DO i=iMin,iMax
222    
223     c use surface layer values and convert to mol/m3
224 stephd 1.3 c and put bounds on tracers so pH solver doesn't blow up
225     surfdic(i,j) =
226     & max(10. _d 0 ,
227 stephd 1.6 & min(4000. _d 0, Ptracer(i,j,kLev,bi,bj,iDIC)))*1e-3
228 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
229 stephd 1.3 surfalk(i,j) =
230     & max(10. _d 0 ,
231 stephd 1.6 & min(4000. _d 0, Ptracer(i,j,kLev,bi,bj,iALK)))*1e-3
232 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
233 stephd 1.3 surfphos(i,j) =
234     & max(1. _d -10,
235 stephd 1.6 & min(10. _d 0, Ptracer(i,j,kLev,bi,bj,iPO4)))*1e-3
236 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
237 stephd 1.3 surfsi(i,j) =
238     & max(1. _d -8,
239 stephd 1.6 & min(500. _d 0, Ptracer(i,j,kLev,bi,bj,iSi)))*1e-3
240 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
241 stephd 1.3 surfsalt(i,j) =
242     & max(4. _d 0, min(50. _d 0, salt(i,j,kLev,bi,bj)))
243     surftemp(i,j) =
244     & max(-4. _d 0, min(39. _d 0, theta(i,j,kLev,bi,bj)))
245 jahn 1.1 c
246     WIND(i,j,bi,bj) = 5. _d 0*maskC(i,j,1,bi,bj)
247     AtmosP(i,j,bi,bj) = 1. _d 0*maskC(i,j,1,bi,bj)
248     ENDDO
249     ENDDO
250    
251     CALL CARBON_COEFFS(
252 stephd 1.3 I surftemp,surfsalt,
253 stephd 1.5 I bi,bj,iMin,iMax,jMin,jMax,
254     I kLev,myThid)
255 jahn 1.1
256     C====================================================================
257    
258     IF ( .NOT.pH_isLoaded ) THEN
259     C set guess of pH for first step here
260    
261     print*,'QQ: pCO2 approximation method'
262     c first approximation
263     C$TAF LOOP = parallel
264     DO j=jMin,jMax
265     C$TAF LOOP = parallel
266     DO i=iMin,iMax
267     IF ( maskC(i,j,kLev,bi,bj) .NE. 0. _d 0) THEN
268     C$TAF init dic_surf = static, 10
269     DO it=1,10
270     C$TAF STORE pH(i,j,bi,bj), PTR_CO2(i,j,kLev) = dic_surf
271     C$TAF STORE surfalk(i,j), surfphos(i,j), surfsi(i,j) = dic_surf
272     CALL CALC_PCO2_APPROX(
273 stephd 1.3 I surftemp(i,j),surfsalt(i,j),
274 jahn 1.1 I surfdic(i,j), surfphos(i,j),
275     I surfsi(i,j),surfalk(i,j),
276     I ak1(i,j,bi,bj),ak2(i,j,bi,bj),
277     I ak1p(i,j,bi,bj),ak2p(i,j,bi,bj),ak3p(i,j,bi,bj),
278     I aks(i,j,bi,bj),akb(i,j,bi,bj),akw(i,j,bi,bj),
279 stephd 1.2 I aksi(i,j,bi,bj),akf(i,j,bi,bj),
280     I ak0(i,j,bi,bj), fugf(i,j,bi,bj),
281     I ff(i,j,bi,bj),
282 jahn 1.1 I bt(i,j,bi,bj),st(i,j,bi,bj),ft(i,j,bi,bj),
283 stephd 1.6 #ifdef pH_3D
284     U pH(i,j,kLev,bi,bj),pCO2(i,j,kLev,bi,bj),
285     #else
286 jahn 1.1 U pH(i,j,bi,bj),pCO2(i,j,bi,bj),
287 stephd 1.6 #endif
288 jahn 1.1 I myThid )
289     ENDDO
290     ENDIF
291     ENDDO
292     ENDDO
293     iprt = MIN(20,sNx)
294     jprt = MIN(20,sNy)
295 stephd 1.6 #ifdef pH_3D
296     print*,'QQ first guess pH',kLev, pH(iprt,jprt,kLev,bi,bj),
297     & theta(iprt,jprt,kLev,bi,bj), salt(iprt,jprt,kLev,bi,bj),
298     & surfdic(iprt,jprt), surfphos(iprt,jprt),
299     & surfsi(iprt,jprt),surfalk(iprt,jprt)
300     #else
301 jahn 1.1 print*,'QQ first guess pH', pH(iprt,jprt,bi,bj),
302     & theta(iprt,jprt,1,bi,bj), salt(iprt,jprt,1,bi,bj),
303     & surfdic(iprt,jprt), surfphos(iprt,jprt),
304     & surfsi(iprt,jprt),surfalk(iprt,jprt)
305 stephd 1.6 #endif
306     ENDIF
307    
308     #ifdef pH_3D
309     ENDDO
310     #endif
311 jahn 1.1
312    
313     C end bi,bj loops
314     ENDDO
315     ENDDO
316    
317     RETURN
318     END
319     #endif /*ALLOW_CARBON*/
320    
321     #endif /*DARWIN*/
322     #endif /*ALLOW_PTRACERS*/
323     c ==================================================================

  ViewVC Help
Powered by ViewVC 1.1.22