source: branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zflx.F90 @ 775

Last change on this file since 775 was 775, checked in by gm, 13 years ago

dev_001_GM - PISCES in F90 : encapsulation of all p4z…F files in module F90 + doctor norme for local variables - compilation OK

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.9 KB
Line 
1MODULE p4zflx
2   !!======================================================================
3   !!                         ***  MODULE p4zflx  ***
4   !! TOP :   PISCES CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
5   !!======================================================================
6   !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code
7   !!              -   !  1998     (O. Aumont) additions
8   !!              -   !  1999     (C. Le Quere) modifications
9   !!             1.0  !  2004     (O. Aumont) modifications
10   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
11   !!----------------------------------------------------------------------
12#if defined key_pisces
13   !!----------------------------------------------------------------------
14   !!   'key_pisces'                                       PISCES bio-model
15   !!----------------------------------------------------------------------
16   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
17   !!----------------------------------------------------------------------
18   USE oce_trc         !
19   USE trp_trc
20   USE sms
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p4z_flx    ! called in p4zprg.F90
26
27   !!* Substitution
28#  include "domzgr_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
31   !! $Header:$
32   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34
35CONTAINS
36
37   SUBROUTINE p4z_flx
38      !!---------------------------------------------------------------------
39      !!                     ***  ROUTINE p4z_flx  ***
40      !!
41      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
42      !!
43      !! ** Method  : - ???
44      !!---------------------------------------------------------------------
45      INTEGER  ::   ji, jj, jrorr
46      REAL(wp) ::   zpdtan, zttc, zws
47      REAL(wp) ::   zfld, zflu, zoxy16, zflu16, zfact
48      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zschmitto2, zalka, zschmittco2
49      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3
50      !!---------------------------------------------------------------------
51
52      ! -----------------------------------------------------
53      !     ASSIGNATION TO EXPONENTS IN THE LISS AND MERLIVAT
54      !     FORMULATION OF THE GAS EXCHANGE RATE
55      ! -----------------------------------------------------
56
57      zpdtan = raass / rdt
58
59      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN
60      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION
61      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
62
63      DO jrorr = 1, 10
64
65         DO jj = 1, jpj
66            DO ji = 1, jpi
67
68               ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
69               zbot  = borat(ji,jj,1)
70               zfact = rhop(ji,jj,1) / 1000. + rtrn
71               zdic  = trn(ji,jj,1,jpdic) / zfact
72               zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
73               zalka = trn(ji,jj,1,jptal) / zfact
74
75               ! CALCULATE [ALK]([CO3--], [HCO3-])
76               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph + zbot / ( 1.+ zph / akb3(ji,jj,1) )  )
77
78               ! CALCULATE [H+] AND [H2CO3]
79               zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   &
80                  &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  )
81               zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 )
82               zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact
83               hi(ji,jj,1)   = zah2 * zfact
84            END DO
85         END DO
86      END DO
87
88
89      ! --------------
90      ! COMPUTE FLUXES
91      ! --------------
92
93      ! FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
94      ! -------------------------------------------
95
96      DO jj = 1, jpj
97         DO ji = 1, jpi
98
99            zttc = MIN( 35., tn(ji,jj,1) )
100!!gm  optimisation & more precise computation with factorisation of the polynome
101            zschmittco2 = 2073.1 - 125.62 * zttc + 3.6276 * zttc**2 - 0.043126 * zttc**3
102            zws         = vatm(ji,jj)
103
104            ! COMPUTE GAS EXCHANGE FOR CO2
105            zkgco2(ji,jj) = (  0.3 * zws * zws    &
106               &             + 2.5 * ( 0.5246 + zttc * ( 0.016256 + zttc * 0.00049946 ) )  )   &
107               &          * SQRT( 660./ zschmittco2 )
108
109            ! CONVERT TO m/s, and apply sea-ice cover
110            zkgco2(ji,jj) = zkgco2(ji,jj) / ( 100. * 3600. )      &
111# if defined key_off_degrad
112               &         * facvol(ji,jj,1)      &
113# endif
114               &         * ( 1.- freeze(ji,jj) ) * tmask(ji,jj,1)
115
116         END DO
117      END DO
118
119      ! COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM Waninkhof EQUATIONS
120      DO jj = 1, jpj
121         DO ji = 1, jpi
122
123          zws  = vatm(ji,jj)
124          zttc = MIN( 35., tn(ji,jj,1) )
125!!gm  optimisation & more precise computation with factorisation of the polynome
126          zschmitto2   = 1953.4 - 128.0 * zttc + 3.9918 * zttc**2 - 0.050091 * zttc**3
127
128          zkgo2(ji,jj) = (  0.3 * zws * zws   &
129             &            + 2.5 * ( 0.5246 + zttc * ( 0.016256 + zttc * 0.00049946 ) )  )   &
130             &         * SQRT( 660./ zschmitto2 )
131
132          ! CONVERT TO m/s AND APPLY SEA ICE COVER
133          zkgo2(ji,jj) = zkgo2(ji,jj) / ( 100.*3600.)        &
134# if defined key_off_degrad
135             &        * facvol(ji,jj,1)       &
136# endif
137             &        * ( 1.- freeze(ji,jj) ) *tmask(ji,jj,1)
138
139         END DO
140      END DO
141
142      DO jj = 1, jpj
143         DO ji = 1, jpi
144
145            ! Compute CO2 flux for the sea and air
146            zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,3) * zkgco2(ji,jj)
147            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)
148            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
149
150            ! Compute O2 flux
151            zoxy16 = trn(ji,jj,1,jpoxy)
152            zflu16 = ( atcox * chemc(ji,jj,2) - zoxy16 ) * zkgo2(ji,jj)
153            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zflu16 / fse3t(ji,jj,1)
154
155# if defined key_trc_diaadd
156            ! Save diagnostics
157            trc2d(ji,jj,1) = ( zfld - zflu ) * 1000.
158            trc2d(ji,jj,2) = zflu16 * 1000.
159            trc2d(ji,jj,3) = zkgco2(ji,jj)
160            trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,3) + rtrn )
161# endif
162         END DO
163      END DO
164      !
165   END SUBROUTINE p4z_flx
166
167#else
168   !!======================================================================
169   !!  Dummy module :                                   No PISCES bio-model
170   !!======================================================================
171CONTAINS
172   SUBROUTINE p4z_flx( kt )                   ! Empty routine
173      INTEGER, INTENT( in ) ::   kt
174      WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt
175   END SUBROUTINE p4z_flx
176#endif 
177
178   !!======================================================================
179END MODULE  p4zflx
Note: See TracBrowser for help on using the repository browser.