New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
p4zflx.F in tags/nemo_v2_2/NEMO/TOP_SRC/SMS – NEMO

source: tags/nemo_v2_2/NEMO/TOP_SRC/SMS/p4zflx.F @ 630

Last change on this file since 630 was 617, checked in by opalod, 17 years ago

* empty log message *

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 5.1 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
6CDIR$ LIST
7      SUBROUTINE p4zflx
8#if defined key_passivetrc && defined key_trc_pisces
9CCC---------------------------------------------------------------------
10CCC
11CCC          ROUTINE p4zflx : PISCES MODEL
12CCC          *****************************
13CCC
14CCC
15CC     PURPOSE.
16CC     --------
17CC          *P4ZFLX* CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
18CC
19CC     EXTERNALS.
20CC     ----------
21CC          NONE.
22CC
23CC   MODIFICATIONS:
24CC   --------------
25CC      original      : 1988-07 E. MAIER-REIMER      MPI HAMBURG
26CC      additions     : 1998    O. Aumont
27CC      modifications : 1999    C. Le Quere
28CC      modifications : 2004    O. Aumont
29CC     -----------------------------------------------------------------
30CC  parameters and commons
31CC ======================
32CDIR$ NOLIST
33      USE oce_trc
34      USE trp_trc
35      USE sms
36      IMPLICIT NONE
37#include "domzgr_substitute.h90"
38CDIR$ LIST
39CC----------------------------------------------------------------------
40CC local declarations
41CC ==================
42C
43      INTEGER nspyr, ji, jj, krorr
44      REAL zpdtan
45      REAL kgco2(jpi,jpj),kgo2(jpi,jpj),h2co3(jpi,jpj)
46      REAL ttc, ws
47      REAL fld, flu, oxy16, flu16, zfact
48      REAL zph,ah2,zbot,zdic,zalk,schmitto2, zalka
49      REAL schmittco2
50C
51C
52C  1. ASSIGNATION TO EXPONENTS IN THE LISS AND MERLIVAT
53C     FORMULATION OF THE GAS EXCHANGE RATE
54c -----------------------------------------------------
55C
56      zpdtan = raass / rdt
57      nspyr  = nint(zpdtan)
58
59C
60C* 1.1 SURFACE CHEMISTRY (PCO2 AND [H+] IN
61C     SURFACE LAYER); THE RESULT OF THIS CALCULATION
62C     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
63C ---------------------------------------------------
64C
65      DO krorr = 1,10
66C
67        DO jj = 1,jpj
68          DO ji = 1,jpi
69C
70C* 1.2 DUMMY VARIABLES FOR DIC, H+, AND BORATE
71C --------------------------------------------
72C
73        zbot = borat(ji,jj,1)
74        zfact = rhop(ji,jj,1)/1000.+rtrn
75        zdic  = trn(ji,jj,1,jpdic)/zfact
76        zph = max(hi(ji,jj,1),1.E-10)/zfact
77        zalka = trn(ji,jj,1,jptal)/zfact
78C
79C* 1.3 CALCULATE [ALK]([CO3--], [HCO3-])
80C ------------------------------------
81C
82        zalk=zalka-
83     &        (akw3(ji,jj,1)/zph-zph+zbot/(1.+zph/akb3(ji,jj,1)))
84C
85C* 1.4 CALCULATE [H+] AND [H2CO3]
86C -----------------------------------------
87C
88         ah2=sqrt((zdic-zalk)**2+4*(zalk*ak23(ji,jj,1)
89     &     /ak13(ji,jj,1))*(2*zdic-zalk))
90        ah2=0.5*ak13(ji,jj,1)/zalk*((zdic-zalk)+ah2)
91        h2co3(ji,jj) = (2*zdic-zalk)/(2.+ak13(ji,jj,1)/ah2)*zfact
92        hi(ji,jj,1)  = ah2*zfact
93          END DO
94        END DO
95      END DO
96C
97C
98C 2. COMPUTE FLUXES
99C --------------
100C
101C 2.1 FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
102C -------------------------------------------
103C
104      DO jj = 1,jpj
105        DO ji = 1,jpi
106C
107          ttc = min(35.,tn(ji,jj,1))
108          schmittco2=2073.1-125.62*ttc+3.6276*ttc**2
109     &      -0.043126*ttc**3
110          ws=vatm(ji,jj)
111C
112C 2.2 COMPUTE GAS EXCHANGE FOR CO2
113C --------------------------------
114C
115          kgco2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
116     &      ttc*0.00049946)))*sqrt(660./schmittco2)
117C
118C 2.3 CONVERT TO m/s, and apply sea-ice cover
119C -----------------------------------------------------
120C
121          kgco2(ji,jj) = kgco2(ji,jj)/(100.*3600.)
122     &      *(1-freeze(ji,jj))*tmask(ji,jj,1)
123#    if defined key_off_degrad
124     &        *facvol(ji,jj,1)
125#    endif
126C
127         END DO
128       END DO
129C
130C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM
131C      Waninkhof EQUATIONS
132C -----------------------------------------------
133C
134       DO jj = 1,jpj
135         DO ji = 1,jpi
136C
137          ws = vatm(ji,jj)
138          schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2
139     &      -0.050091*ttc**3
140
141          kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
142     &      ttc*0.00049946)))*sqrt(660./schmitto2)
143
144C
145C CONVERT TO m/s AND APPLY SEA ICE COVER
146C -------------------------------------
147C
148          kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.)
149     &      *(1-freeze(ji,jj))*tmask(ji,jj,1)
150#    if defined key_off_degrad
151     &        *facvol(ji,jj,1)
152#    endif
153C
154         ENDDO
155       ENDDO
156C
157       DO jj = 1,jpj
158         DO ji = 1,jpi
159C
160C Compute CO2 flux for the sea and air
161C ------------------------------------
162C
163          fld = atcco2*tmask(ji,jj,1)*chemc(ji,jj,3)*kgco2(ji,jj)
164          flu = h2co3(ji,jj)*tmask(ji,jj,1)*kgco2(ji,jj)
165          tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu)
166     &      /fse3t(ji,jj,1)
167C
168C Compute O2 flux 
169C ---------------
170C
171          oxy16 = trn(ji,jj,1,jpoxy)
172          flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj)
173          tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16
174     &      /fse3t(ji,jj,1)
175C
176C Save diagnostics
177C ----------------
178C
179#    if defined key_trc_diaadd
180          trc2d(ji,jj,1) = (fld-flu)*1000.
181          trc2d(ji,jj,2) = flu16*1000.
182          trc2d(ji,jj,3) = kgco2(ji,jj)
183          trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,1)+rtrn)
184#    endif
185C
186        END DO
187      END DO
188C
189#endif
190      RETURN
191      END
Note: See TracBrowser for help on using the repository browser.