source: trunk/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 933

Last change on this file since 933 was 933, checked in by cetlod, 13 years ago

adding modules the CFC model, see ticket 140

File size: 11.5 KB
Line 
1MODULE trcsms_cfc
2   !!======================================================================
3   !!                      ***  MODULE trcsms_cfc  ***
4   !! TOP : CFC main model
5   !!======================================================================
6   !! History :    -   !  1999-10  (JC. Dutay)  original code
7   !!             1.0  !  2004-03 (C. Ethe) free form + modularity
8   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
9   !!----------------------------------------------------------------------
10#if defined key_cfc
11   !!----------------------------------------------------------------------
12   !!   'key_cfc'                                               CFC tracers
13   !!----------------------------------------------------------------------
14   !!   trc_sms_cfc     :  compute and add CFC suface forcing to CFC trends
15   !!   trc_cfc_cst :  sets constants for CFC surface forcing computation
16   !!----------------------------------------------------------------------
17   USE daymod       ! calendar
18   USE oce_trc      ! Ocean variables
19   USE par_trc      ! TOP parameters
20   USE trc          ! TOP variables
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   trc_sms_cfc       ! called in ???   
26
27   INTEGER , PUBLIC, PARAMETER ::   jpyear = 100   ! temporal parameter
28   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
29   INTEGER , PUBLIC    ::   ndate_beg      ! initial calendar date (aammjj) for CFC
30   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
31   INTEGER , PUBLIC    ::   nyear_beg      ! initial year (aa)
32   
33   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc0:jp_cfc1) ::   p_cfc   ! partial hemispheric pressure for CFC         
34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)                       ::   xphem    ! spatial interpolation factor for patm
35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj      ,jp_cfc0:jp_cfc1) ::   qtr      ! input function
36   REAL(wp), PUBLIC, DIMENSION(jpi,jpj      ,jp_cfc0:jp_cfc1) ::   qint     ! flux function
37
38   REAL(wp), DIMENSION(jp_cfc) ::   soa1, soa2, soa3, soa4   ! coefficient for solubility of CFC [mol/l/atm]
39   REAL(wp), DIMENSION(jp_cfc) ::   sob1, sob2, sob3         !    "               "
40   REAL(wp), DIMENSION(jp_cfc) ::   sca1, sca2, sca3, sca4   ! coefficients for schmidt number in degre Celcius
41     
42   !                          ! coefficients for conversion
43   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
44   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
45   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
46   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv
47
48   REAL(wp) ::   xrhoa  = 1.22         ! Air density kg/m3
49   REAL(wp) ::   xcd    = 1.5e-3       ! drag coefficient
50
51   !! * Substitutions
52#  include "top_substitute.h90"
53   !!----------------------------------------------------------------------
54   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
55   !! $Id: trccfc.F90 776 2007-12-19 14:10:14Z gm $
56   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58
59CONTAINS
60
61   SUBROUTINE trc_sms_cfc( kt )
62      !!----------------------------------------------------------------------
63      !!                     ***  ROUTINE trc_sms_cfc  ***
64      !!
65      !! ** Purpose :   Compute the surface boundary contition on CFC 11
66      !!             passive tracer associated with air-mer fluxes and add it
67      !!             to the general trend of tracers equations.
68      !!
69      !! ** Method  : - get the atmospheric partial pressure - given in pico -
70      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
71      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
72      !!              - the input function is given by :
73      !!                speed * ( concentration at equilibrium - concentration at surface )
74      !!              - the input function is in pico-mol/m3/s and the
75      !!                CFC concentration in pico-mol/m3
76      !!----------------------------------------------------------------------
77      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
78      !!
79      INTEGER ::   ji, jj, jn, jm
80      INTEGER ::   iyear_beg, iyear_end
81      INTEGER ::   im1, im2
82
83      REAL(wp) ::   ztap, zdtap       
84      REAL(wp) ::   zt1, zt2, zt3, zv2
85      REAL(wp) ::   zsol      ! solubility
86      REAL(wp) ::   zsch      ! schmidt number
87      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
88      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
89      REAL(wp) ::   zak_cfc   ! transfert coefficients
90
91      REAL(wp) ::   ztx, zty, ztau
92      REAL(wp), DIMENSION(jpi,jpj)        :: zws     ! wind speed
93
94      REAL(wp), DIMENSION(jphem,jp_cfc)   ::   zpatm       ! atmospheric function
95      !!----------------------------------------------------------------------
96
97      IF( kt == nittrc000 )   CALL trc_cfc_cst
98
99      ! Temporal interpolation
100      ! ----------------------
101      iyear_beg = nyear + ( nyear_res - 1900 - nyear_beg  )
102      IF ( nmonth <= 6 ) THEN
103         iyear_beg = iyear_beg - 2 + nyear_beg
104         im1       =  6 - nmonth + 1
105         im2       =  6 + nmonth - 1
106      ELSE
107         iyear_beg = iyear_beg - 1 + nyear_beg
108         im1       = 12 - nmonth + 7
109         im2       =      nmonth - 7
110      ENDIF
111      iyear_end = iyear_beg + 1
112
113
114      ! Estimation of wind speed as a function of wind stress
115!CDIR NOVERRCHK
116      DO jj = 1, jpj
117!CDIR NOVERRCHK
118         DO ji = 1, jpi
119            ztx  = utau(ji,jj) * umask(ji,jj,1)
120            zty  = vtau(ji,jj) * vmask(ji,jj,1)
121            ztau = SQRT( ztx * ztx + zty * zty )
122            zws(ji,jj) = SQRT ( ztau / ( xrhoa * xcd ) )
123         ENDDO
124      ENDDO
125
126      !                                                         !------------!
127      DO jn = jp_cfc0, jp_cfc1                                  !  CFC loop  !
128         !                                                      !------------!
129         ! time interpolation at time kt
130         DO jm = 1, jphem
131            zpatm(jm,jn) = (  p_cfc(iyear_beg, jm, jn) * FLOAT (im1)  &
132               &           +  p_cfc(iyear_end, jm, jn) * FLOAT (im2) ) / 12.
133         END DO
134         
135         !                                                         !------------!
136         DO jj = 1, jpj                                            !  i-j loop  !
137            DO ji = 1, jpi                                         !------------!
138 
139               ! space interpolation
140               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jn)   &
141                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jn)
142
143               ! Computation of concentration at equilibrium : in picomol/l
144               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
145               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
146                  ztap  = ( tn(ji,jj,1) + 273.16 ) * 0.01
147                  zdtap = ( sob3(jn) * ztap + sob2(jn) ) * ztap + sob1(jn) 
148                  zsol  =  EXP( soa1(jn) + soa2(jn) / ztap + soa3(jn) * LOG( ztap )   &
149                     &                   + soa4(jn) * ztap * ztap + sn(ji,jj,1) * zdtap ) 
150               ELSE
151                  zsol  = 0.e0
152               ENDIF
153               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
154               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
155               ! concentration at equilibrium
156               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
157 
158               ! Computation of speed transfert
159               !    Schmidt number
160               zt1  = tn(ji,jj,1)
161               zt2  = zt1 * zt1 
162               zt3  = zt1 * zt2
163               zsch = sca1(jn) + sca2(jn) * zt1 + sca3(jn) * zt2 + sca4(jn) * zt3
164
165               !    speed transfert : formulae of wanninkhof 1992
166               zv2     = zws(ji,jj) * zws(ji,jj)
167               zsch    = zsch / 660.
168               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
169
170               ! Input function  : speed *( conc. at equil - concen at surface )
171               ! trn in pico-mol/l idem qtr; ak in en m/s
172               qtr(ji,jj,jn) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
173#if defined key_off_degrad
174                  &                     * facvol(ji,jj,1)                           &
175#endif
176                  &                     * tmask(ji,jj,1) * ( 1. - freeze(ji,jj) )
177
178               ! Add the surface flux to the trend
179               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr(ji,jj,jn) / fse3t(ji,jj,1) 
180
181               ! cumulation of surface flux at each time step
182               qint(ji,jj,jn) = qint (ji,jj,jn) + qtr(ji,jj,jn) * rdt
183               !                                               !----------------!
184            END DO                                             !  end i-j loop  !
185         END DO                                                !----------------!
186         !                                                  !----------------!
187      END DO                                                !  end CFC loop  !
188      !                                                     !----------------!
189   END SUBROUTINE trc_sms_cfc
190
191
192   SUBROUTINE trc_cfc_cst
193      !!---------------------------------------------------------------------
194      !!                     ***  trc_cfc_cst  *** 
195      !!
196      !! ** Purpose : sets constants for CFC model
197      !!---------------------------------------------------------------------
198      INTEGER ::   jn
199      !!---------------------------------------------------------------------
200
201      DO jn = jp_cfc0, jp_cfc1
202         IF ( jn == jp11 ) THEN
203            ! coefficient for solubility of CFC11 in  mol/l/atm
204            soa1(jn) = -229.9261 
205            soa2(jn) =  319.6552
206            soa3(jn) =  119.4471
207            soa4(jn) =   -1.39165
208            sob1(jn) =   -0.142382
209            sob2(jn) =    0.091459
210            sob3(jn) =   -0.0157274
211           
212            ! coefficients for schmidt number in degre Celcius
213            sca1(jn) = 3501.8
214            sca2(jn) = -210.31
215            sca3(jn) =    6.1851
216            sca4(jn) =   -0.07513
217
218         ELSE IF( jn == jp12 ) THEN
219
220            ! coefficient for solubility of CFC12 in  mol/l/atm
221            soa1(jn) = -218.0971
222            soa2(jn) =  298.9702
223            soa3(jn) =  113.8049
224            soa4(jn) =   -1.39165
225            sob1(jn) =   -0.143566
226            sob2(jn) =    0.091015
227            sob3(jn) =   -0.0153924
228                       
229            ! coefficients for schmidt number in degre Celcius
230            sca1(jn) =  3845.4 
231            sca2(jn) =  -228.95
232            sca3(jn) =     6.1908 
233            sca4(jn) =    -0.067430
234         ENDIF
235
236         WRITE(numout,*) 'coefficient for solubility of tracer',ctrcnm(jn)
237         WRITE(numout,*) soa1(jn), soa2(jn),soa3(jn), soa4(jn), &
238            &           sob1(jn), sob2(jn),sob3(jn)
239         WRITE(numout,*) 
240         WRITE(numout,*) 'coefficient for schmidt of tracer',ctrcnm(jn)
241         WRITE(numout,*) sca1(jn), sca2(jn),sca3(jn), sca4(jn)
242      END DO
243      !
244   END SUBROUTINE trc_cfc_cst
245   
246#else
247   !!----------------------------------------------------------------------
248   !!   Dummy module                                         No CFC tracers
249   !!----------------------------------------------------------------------
250CONTAINS
251   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
252      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
253   END SUBROUTINE trc_sms_cfc
254#endif
255
256   !!======================================================================
257END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.