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 branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zflx.F @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

  • 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_top && defined key_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          ttc = min(35.,tn(ji,jj,1))
139          schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2
140     &      -0.050091*ttc**3
141
142          kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
143     &      ttc*0.00049946)))*sqrt(660./schmitto2)
144
145C
146C CONVERT TO m/s AND APPLY SEA ICE COVER
147C -------------------------------------
148C
149          kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.)
150     &      *(1-freeze(ji,jj))*tmask(ji,jj,1)
151#    if defined key_off_degrad
152     &        *facvol(ji,jj,1)
153#    endif
154C
155         ENDDO
156       ENDDO
157C
158       DO jj = 1,jpj
159         DO ji = 1,jpi
160C
161C Compute CO2 flux for the sea and air
162C ------------------------------------
163C
164          fld = atcco2*tmask(ji,jj,1)*chemc(ji,jj,3)*kgco2(ji,jj)
165          flu = h2co3(ji,jj)*tmask(ji,jj,1)*kgco2(ji,jj)
166          tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu)
167     &      /fse3t(ji,jj,1)
168C
169C Compute O2 flux 
170C ---------------
171C
172          oxy16 = trn(ji,jj,1,jpoxy)
173          flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj)
174          tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16
175     &      /fse3t(ji,jj,1)
176C
177C Save diagnostics
178C ----------------
179C
180#    if defined key_trc_diaadd
181          trc2d(ji,jj,1) = (fld-flu)*1000.
182          trc2d(ji,jj,2) = flu16*1000.
183          trc2d(ji,jj,3) = kgco2(ji,jj)
184          trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,3)+rtrn)
185#    endif
186C
187        END DO
188      END DO
189C
190#endif
191      RETURN
192      END
Note: See TracBrowser for help on using the repository browser.