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 trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/p4zflx.F @ 491

Last change on this file since 491 was 341, checked in by opalod, 19 years ago

nemo_v1_update_028 : CT : add missing headers

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 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)
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)
58C
59C* 1.1 SURFACE CHEMISTRY (PCO2 AND [H+] IN
60C     SURFACE LAYER); THE RESULT OF THIS CALCULATION
61C     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
62C ---------------------------------------------------
63C
64      DO krorr = 1,10
65C
66        DO jj = 1,jpj
67          DO ji = 1,jpi
68C
69C* 1.2 DUMMY VARIABLES FOR DIC, H+, AND BORATE
70C --------------------------------------------
71C
72        zbot = borat(ji,jj,1)
73        zfact = rhop(ji,jj,1)/1000.+rtrn
74        zdic  = trn(ji,jj,1,jpdic)/zfact
75        zph = max(hi(ji,jj,1),1.E-10)/zfact
76        zalka = trn(ji,jj,1,jptal)/zfact
77C
78C* 1.3 CALCULATE [ALK]([CO3--], [HCO3-])
79C ------------------------------------
80C
81        zalk=zalka-
82     &        (akw3(ji,jj,1)/zph-zph+zbot/(1.+zph/akb3(ji,jj,1)))
83C
84C* 1.4 CALCULATE [H+] AND [H2CO3]
85C -----------------------------------------
86C
87         ah2=sqrt((zdic-zalk)**2+4*(zalk*ak23(ji,jj,1)
88     &     /ak13(ji,jj,1))*(2*zdic-zalk))
89        ah2=0.5*ak13(ji,jj,1)/zalk*((zdic-zalk)+ah2)
90        h2co3(ji,jj) = (2*zdic-zalk)/(2.+ak13(ji,jj,1)/ah2)*zfact
91        hi(ji,jj,1)  = ah2*zfact
92          END DO
93        END DO
94      END DO
95C
96C
97C 2. COMPUTE FLUXES
98C --------------
99C
100C 2.1 FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
101C -------------------------------------------
102C
103      DO jj = 1,jpj
104        DO ji = 1,jpi
105C
106          ttc = min(35.,tn(ji,jj,1))
107          schmittco2=2073.1-125.62*ttc+3.6276*ttc**2
108     &      -0.043126*ttc**3
109          ws=vatm(ji,jj)
110C
111C 2.2 COMPUTE GAS EXCHANGE FOR CO2
112C --------------------------------
113C
114          kgco2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
115     &      ttc*0.00049946)))*sqrt(660./schmittco2)
116C
117C 2.3 CONVERT TO m/s, and apply sea-ice cover
118C -----------------------------------------------------
119C
120          kgco2(ji,jj) = kgco2(ji,jj)/(100.*3600.)
121     &      *(1-freeze(ji,jj))*tmask(ji,jj,1)
122C
123         END DO
124       END DO
125C
126C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM
127C      Waninkhof EQUATIONS
128C -----------------------------------------------
129C
130       DO jj = 1,jpj
131         DO ji = 1,jpi
132C
133          ws = vatm(ji,jj)
134          schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2
135     &      -0.050091*ttc**3
136
137          kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
138     &      ttc*0.00049946)))*sqrt(660./schmitto2)
139C
140C CONVERT TO m/s AND APPLY SEA ICE COVER
141C -------------------------------------
142C
143          kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.)
144     $      *(1-freeze(ji,jj))*tmask(ji,jj,1)
145C
146         ENDDO
147       ENDDO
148C
149       DO jj = 1,jpj
150         DO ji = 1,jpi
151C
152C Compute CO2 flux for the sea and air
153C ------------------------------------
154C
155          fld = atcco2*tmask(ji,jj,1)*chemc(ji,jj,3)*kgco2(ji,jj)
156          flu = h2co3(ji,jj)*tmask(ji,jj,1)*kgco2(ji,jj)
157          tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu)
158     &      /fse3t(ji,jj,1)
159C
160C Compute O2 flux 
161C ---------------
162C
163          oxy16 = trn(ji,jj,1,jpoxy)
164          flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj)
165          tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16
166     &      /fse3t(ji,jj,1)
167C
168C Save diagnostics
169C ----------------
170C
171#    if defined key_trc_diaadd
172          trc2d(ji,jj,1) = (fld-flu)*1000.
173          trc2d(ji,jj,2) = flu16*1000.
174          trc2d(ji,jj,3) = kgco2(ji,jj)
175          trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,1)+rtrn)
176#    endif
177C
178        END DO
179      END DO
180C
181#endif
182      RETURN
183      END
Note: See TracBrowser for help on using the repository browser.