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.
trccfc.F90 in branches/dev_001_GM/NEMO/TOP_SRC/CFC – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/CFC/trccfc.F90 @ 769

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

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