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 @ 433

Last change on this file since 433 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
RevLine 
[341]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 ---------------------------------------------------------------------------
[186]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
[339]37#include "domzgr_substitute.h90"
[186]38CDIR$ LIST
39CC----------------------------------------------------------------------
40CC local declarations
41CC ==================
42C
[339]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
[186]50C
51C
52C  1. ASSIGNATION TO EXPONENTS IN THE LISS AND MERLIVAT
53C     FORMULATION OF THE GAS EXCHANGE RATE
54c -----------------------------------------------------
55C
[339]56      zpdtan = raass / rdt
57      nspyr  = nint(zpdtan)
[186]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
[339]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
[186]77C
78C* 1.3 CALCULATE [ALK]([CO3--], [HCO3-])
79C ------------------------------------
80C
[339]81        zalk=zalka-
82     &        (akw3(ji,jj,1)/zph-zph+zbot/(1.+zph/akb3(ji,jj,1)))
[186]83C
84C* 1.4 CALCULATE [H+] AND [H2CO3]
85C -----------------------------------------
86C
[339]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
[186]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
[339]105C
[186]106          ttc = min(35.,tn(ji,jj,1))
[339]107          schmittco2=2073.1-125.62*ttc+3.6276*ttc**2
108     &      -0.043126*ttc**3
109          ws=vatm(ji,jj)
[186]110C
111C 2.2 COMPUTE GAS EXCHANGE FOR CO2
112C --------------------------------
113C
[339]114          kgco2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
115     &      ttc*0.00049946)))*sqrt(660./schmittco2)
[186]116C
[339]117C 2.3 CONVERT TO m/s, and apply sea-ice cover
118C -----------------------------------------------------
[186]119C
[339]120          kgco2(ji,jj) = kgco2(ji,jj)/(100.*3600.)
121     &      *(1-freeze(ji,jj))*tmask(ji,jj,1)
[186]122C
123         END DO
124       END DO
125C
[339]126C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM
127C      Waninkhof EQUATIONS
128C -----------------------------------------------
[186]129C
130       DO jj = 1,jpj
131         DO ji = 1,jpi
132C
[339]133          ws = vatm(ji,jj)
134          schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2
135     &      -0.050091*ttc**3
[186]136
[339]137          kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+
138     &      ttc*0.00049946)))*sqrt(660./schmitto2)
[186]139C
[339]140C CONVERT TO m/s AND APPLY SEA ICE COVER
[186]141C -------------------------------------
142C
[339]143          kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.)
144     $      *(1-freeze(ji,jj))*tmask(ji,jj,1)
[186]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
[339]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)
[186]159C
160C Compute O2 flux 
161C ---------------
162C
163          oxy16 = trn(ji,jj,1,jpoxy)
[339]164          flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj)
[186]165          tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16
[339]166     &      /fse3t(ji,jj,1)
[186]167C
168C Save diagnostics
169C ----------------
170C
171#    if defined key_trc_diaadd
[339]172          trc2d(ji,jj,1) = (fld-flu)*1000.
[186]173          trc2d(ji,jj,2) = flu16*1000.
[339]174          trc2d(ji,jj,3) = kgco2(ji,jj)
175          trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,1)+rtrn)
[186]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.