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.
trcsms_cfc.F90 in branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 7192

Last change on this file since 7192 was 7192, checked in by cetlod, 8 years ago

new top interface : minor bugfixes
  • Property svn:keywords set to Id
File size: 11.5 KB
Line 
1MODULE trcsms_cfc
2   !!======================================================================
3   !!                      ***  MODULE trcsms_cfc  ***
4   !! TOP : CFC main model
5   !!======================================================================
6   !! History :  OPA  !  1999-10  (JC. Dutay)  original code
7   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity
8   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
9   !!----------------------------------------------------------------------
10   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
11   !!   cfc_init     :  sets constants for CFC surface forcing computation
12   !!----------------------------------------------------------------------
13   USE oce_trc       ! Ocean variables
14   USE par_trc       ! TOP parameters
15   USE trc           ! TOP variables
16   USE trd_oce
17   USE trdtrc
18   USE iom           ! I/O library
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   trc_sms_cfc         ! called in ???   
24   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
25
26   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
27   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
28   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
29   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
30   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)
31   
32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
37
38   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
39   REAL(wp), DIMENSION(3,2) ::   sob   !    "               "
40   REAL(wp), DIMENSION(4,2) ::   sca   ! 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   !!----------------------------------------------------------------------
49   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE trc_sms_cfc( kt )
56      !!----------------------------------------------------------------------
57      !!                     ***  ROUTINE trc_sms_cfc  ***
58      !!
59      !! ** Purpose :   Compute the surface boundary contition on CFC 11
60      !!             passive tracer associated with air-mer fluxes and add it
61      !!             to the general trend of tracers equations.
62      !!
63      !! ** Method  : - get the atmospheric partial pressure - given in pico -
64      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
65      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
66      !!              - the input function is given by :
67      !!                speed * ( concentration at equilibrium - concentration at surface )
68      !!              - the input function is in pico-mol/m3/s and the
69      !!                CFC concentration in pico-mol/m3
70      !!----------------------------------------------------------------------
71      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
72      !
73      INTEGER  ::   ji, jj, jn, jl, jm, js
74      INTEGER  ::   iyear_beg, iyear_end
75      INTEGER  ::   im1, im2, ierr
76      REAL(wp) ::   ztap, zdtap       
77      REAL(wp) ::   zt1, zt2, zt3, zv2
78      REAL(wp) ::   zsol      ! solubility
79      REAL(wp) ::   zsch      ! schmidt number
80      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
81      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
82      REAL(wp) ::   zak_cfc   ! transfert coefficients
83      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
84      !!----------------------------------------------------------------------
85      !
86      !
87      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc')
88      !
89      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
90      IF( ierr > 0 ) THEN
91         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
92      ENDIF
93
94      IF( kt == nittrc000 )   CALL cfc_init
95
96      ! Temporal interpolation
97      ! ----------------------
98      iyear_beg = nyear - 1900
99      IF ( nmonth <= 6 ) THEN
100         iyear_beg = iyear_beg - 1
101         im1       =  6 - nmonth + 1
102         im2       =  6 + nmonth - 1
103      ELSE
104         im1       = 12 - nmonth + 7
105         im2       =      nmonth - 7
106      ENDIF
107      iyear_end = iyear_beg + 1
108
109      !                                                  !------------!
110      DO jl = 1, jp_cfc                                  !  CFC loop  !
111         !                                               !------------!
112         jn = jp_cfc0 + jl - 1
113         ! time interpolation at time kt
114         DO jm = 1, jphem
115            zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  &
116               &           +  p_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
117         END DO
118         
119         !                                                         !------------!
120         DO jj = 1, jpj                                            !  i-j loop  !
121            DO ji = 1, jpi                                         !------------!
122 
123               ! space interpolation
124               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
125                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
126
127               ! Computation of concentration at equilibrium : in picomol/l
128               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
129               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
130                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
131                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
132                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
133                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
134               ELSE
135                  zsol  = 0.e0
136               ENDIF
137               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
138               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
139               ! concentration at equilibrium
140               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
141 
142               ! Computation of speed transfert
143               !    Schmidt number
144               zt1  = tsn(ji,jj,1,jp_tem)
145               zt2  = zt1 * zt1 
146               zt3  = zt1 * zt2
147               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
148
149               !    speed transfert : formulae of wanninkhof 1992
150               zv2     = wndm(ji,jj) * wndm(ji,jj)
151               zsch    = zsch / 660.
152               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
153
154               ! Input function  : speed *( conc. at equil - concen at surface )
155               ! trn in pico-mol/l idem qtr; ak in en m/a
156               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
157                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
158               ! Add the surface flux to the trend
159               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 
160
161               ! cumulation of surface flux at each time step
162               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
163               !                                               !----------------!
164            END DO                                             !  end i-j loop  !
165         END DO                                                !----------------!
166         !                                                  !----------------!
167      END DO                                                !  end CFC loop  !
168      !
169      IF( lrst_trc ) THEN
170         IF(lwp) WRITE(numout,*)
171         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
172            &                    'at it= ', kt,' date= ', ndastp
173         IF(lwp) WRITE(numout,*) '~~~~'
174         DO jn = jp_cfc0, jp_cfc1
175            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
176         END DO
177      ENDIF                                           
178      !
179      IF( lk_iomput ) THEN
180         DO jn = jp_cfc0, jp_cfc1
181            CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) )
182            CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
183         ENDDO
184      END IF
185      !
186      IF( l_trdtrc ) THEN
187          DO jn = jp_cfc0, jp_cfc1
188            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
189          END DO
190      END IF
191      !
192      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
193      !
194   END SUBROUTINE trc_sms_cfc
195
196
197   SUBROUTINE cfc_init
198      !!---------------------------------------------------------------------
199      !!                     ***  cfc_init  *** 
200      !!
201      !! ** Purpose : sets constants for CFC model
202      !!---------------------------------------------------------------------
203      INTEGER :: jn
204
205      ! coefficient for CFC11
206      !----------------------
207
208      ! Solubility
209      soa(1,1) = -229.9261 
210      soa(2,1) =  319.6552
211      soa(3,1) =  119.4471
212      soa(4,1) =  -1.39165
213
214      sob(1,1) =  -0.142382
215      sob(2,1) =   0.091459
216      sob(3,1) =  -0.0157274
217
218      ! Schmidt number
219      sca(1,1) = 3501.8
220      sca(2,1) = -210.31
221      sca(3,1) =  6.1851
222      sca(4,1) = -0.07513
223
224      ! coefficient for CFC12
225      !----------------------
226
227      ! Solubility
228      soa(1,2) = -218.0971
229      soa(2,2) =  298.9702
230      soa(3,2) =  113.8049
231      soa(4,2) =  -1.39165
232
233      sob(1,2) =  -0.143566
234      sob(2,2) =   0.091015
235      sob(3,2) =  -0.0153924
236
237      ! schmidt number
238      sca(1,2) =  3845.4 
239      sca(2,2) =  -228.95
240      sca(3,2) =  6.1908 
241      sca(4,2) =  -0.067430
242
243      IF( ln_rsttr ) THEN
244         IF(lwp) WRITE(numout,*)
245         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
246         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
247         !
248         DO jn = jp_cfc0, jp_cfc1
249            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
250         END DO
251      ENDIF
252      IF(lwp) WRITE(numout,*)
253      !
254   END SUBROUTINE cfc_init
255
256
257   INTEGER FUNCTION trc_sms_cfc_alloc()
258      !!----------------------------------------------------------------------
259      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
260      !!----------------------------------------------------------------------
261      ALLOCATE( xphem   (jpi,jpj)        ,     &
262         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
263         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc )
264         !
265      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
266      !
267   END FUNCTION trc_sms_cfc_alloc
268
269   !!======================================================================
270END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.