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/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 6245

Last change on this file since 6245 was 6216, checked in by jpalmier, 8 years ago

JPALM -- 05-01-2016 -- IDTRA timing checks
File size: 13.7 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#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   !!   cfc_init     :  sets constants for CFC surface forcing computation
16   !!----------------------------------------------------------------------
17   USE dom_oce       ! ocean space and time domain
18   USE oce_trc       ! Ocean variables
19   USE par_trc       ! TOP parameters
20   USE trc           ! TOP variables
21   USE trd_oce
22   USE trdtrc
23   USE iom           ! I/O library
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   trc_sms_cfc         ! called in ???   
29   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
30
31   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
32   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
33   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
34   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
35   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)
36   
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
42
43   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
44   REAL(wp), DIMENSION(3,2) ::   sob   !    "               "
45   REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius
46     
47   !                          ! coefficients for conversion
48   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
49   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
50   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
51   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv
52
53   !! * Substitutions
54#  include "top_substitute.h90"
55   !!----------------------------------------------------------------------
56   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
57   !! $Id$
58   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
59   !!----------------------------------------------------------------------
60CONTAINS
61
62   SUBROUTINE trc_sms_cfc( kt )
63      !!----------------------------------------------------------------------
64      !!                     ***  ROUTINE trc_sms_cfc  ***
65      !!
66      !! ** Purpose :   Compute the surface boundary contition on CFC 11
67      !!             passive tracer associated with air-mer fluxes and add it
68      !!             to the general trend of tracers equations.
69      !!
70      !! ** Method  : - get the atmospheric partial pressure - given in pico -
71      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
72      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
73      !!              - the input function is given by :
74      !!                speed * ( concentration at equilibrium - concentration at surface )
75      !!              - the input function is in pico-mol/m3/s and the
76      !!                CFC concentration in pico-mol/m3
77      !!----------------------------------------------------------------------
78      !
79      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
80      !
81      INTEGER  ::   ji, jj, jn, jl, jm, js
82      INTEGER  ::   iyear_beg, iyear_end
83      INTEGER  ::   im1, im2, ierr
84      REAL(wp) ::   ztap, zdtap       
85      REAL(wp) ::   zt1, zt2, zt3, zv2
86      REAL(wp) ::   zsol      ! solubility
87      REAL(wp) ::   zsch      ! schmidt number
88      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
89      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
90      REAL(wp) ::   zak_cfc   ! transfert coefficients
91      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
92      !!----------------------------------------------------------------------
93      !
94      !
95      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc')
96      !
97      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
98      IF( ierr > 0 ) THEN
99         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
100      ENDIF
101
102      IF( kt == nittrc000 )   CALL cfc_init
103
104      ! Temporal interpolation
105      ! ----------------------
106      iyear_beg = nyear - 1900
107      IF ( nmonth <= 6 ) THEN
108         iyear_beg = iyear_beg - 1
109         im1       =  6 - nmonth + 1
110         im2       =  6 + nmonth - 1
111      ELSE
112         im1       = 12 - nmonth + 7
113         im2       =      nmonth - 7
114      ENDIF
115      iyear_end = iyear_beg + 1
116
117      !                                                  !------------!
118      DO jl = 1, jp_cfc                                  !  CFC loop  !
119         !                                               !------------!
120         jn = jp_cfc0 + jl - 1
121         ! time interpolation at time kt
122         DO jm = 1, jphem
123            zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  &
124               &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12.
125         END DO
126         
127         !                                                         !------------!
128         DO jj = 1, jpj                                            !  i-j loop  !
129            DO ji = 1, jpi                                         !------------!
130 
131               ! space interpolation
132               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
133                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
134
135               ! Computation of concentration at equilibrium : in picomol/l
136               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
137               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
138                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
139                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
140                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
141                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
142               ELSE
143                  zsol  = 0.e0
144               ENDIF
145               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
146               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
147               ! concentration at equilibrium
148               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
149 
150               ! Computation of speed transfert
151               !    Schmidt number
152               zt1  = tsn(ji,jj,1,jp_tem)
153               zt2  = zt1 * zt1 
154               zt3  = zt1 * zt2
155               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
156
157               !    speed transfert : formulae of wanninkhof 1992
158               zv2     = wndm(ji,jj) * wndm(ji,jj)
159               zsch    = zsch / 660.
160               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
161
162               ! Input function  : speed *( conc. at equil - concen at surface )
163               ! trn in pico-mol/l idem qtr; ak in en m/a
164               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
165#if defined key_degrad
166                  &                         * facvol(ji,jj,1)                           &
167#endif
168                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
169               ! Add the surface flux to the trend
170               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
171
172               ! cumulation of surface flux at each time step
173               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
174               !                                               !----------------!
175            END DO                                             !  end i-j loop  !
176         END DO                                                !----------------!
177         !                                                  !----------------!
178      END DO                                                !  end CFC loop  !
179         !
180      IF( kt == nittrc000 ) THEN
181         DO jl = 1, jp_cfc   
182             WRITE(NUMOUT,*) ' '
183             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm 
184             WRITE(NUMOUT,*) '################################## '
185             WRITE(NUMOUT,*) ' '
186               if (jl.EQ.1) then
187                   WRITE(NUMOUT,*) 'Traceur = CFC11: '
188               elseif (jl.EQ.2) then
189                   WRITE(NUMOUT,*) 'Traceur = CFC12: '
190               endif
191             WRITE(NUMOUT,*) 'nyear    = ', nyear
192             WRITE(NUMOUT,*) 'nmonth   = ', nmonth
193             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg
194             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end
195             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl)
196             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl)
197             WRITE(NUMOUT,*) 'Im1= ',im1
198             WRITE(NUMOUT,*) 'Im2= ',im2
199             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc
200             WRITE(NUMOUT,*) ' '
201         END DO 
202# if defined key_debug_medusa
203         CALL flush(numout)
204# endif
205      ENDIF
206        !
207      !IF( lrst_trc ) THEN
208      !   IF(lwp) WRITE(numout,*)
209      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
210      !      &                    'at it= ', kt,' date= ', ndastp
211      !   IF(lwp) WRITE(numout,*) '~~~~'
212      !   DO jn = jp_cfc0, jp_cfc1
213      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
214      !   END DO
215      !ENDIF                                           
216      !
217      IF( lk_iomput ) THEN
218         CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
219         CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
220      ELSE
221         IF( ln_diatrc ) THEN
222            trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
223            trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
224         END IF
225      END IF
226      !
227      IF( l_trdtrc ) THEN
228          DO jn = jp_cfc0, jp_cfc1
229            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
230          END DO
231      END IF
232      !
233# if defined key_debug_medusa
234      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing
235      CALL flush(numout)
236# endif
237      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
238      !
239   END SUBROUTINE trc_sms_cfc
240
241
242   SUBROUTINE cfc_init
243      !!---------------------------------------------------------------------
244      !!                     ***  cfc_init  *** 
245      !!
246      !! ** Purpose : sets constants for CFC model
247      !!---------------------------------------------------------------------
248      INTEGER :: jn
249
250      ! coefficient for CFC11
251      !----------------------
252
253      ! Solubility
254      soa(1,1) = -229.9261 
255      soa(2,1) =  319.6552
256      soa(3,1) =  119.4471
257      soa(4,1) =  -1.39165
258
259      sob(1,1) =  -0.142382
260      sob(2,1) =   0.091459
261      sob(3,1) =  -0.0157274
262
263      ! Schmidt number
264      sca(1,1) = 3501.8
265      sca(2,1) = -210.31
266      sca(3,1) =  6.1851
267      sca(4,1) = -0.07513
268
269      ! coefficient for CFC12
270      !----------------------
271
272      ! Solubility
273      soa(1,2) = -218.0971
274      soa(2,2) =  298.9702
275      soa(3,2) =  113.8049
276      soa(4,2) =  -1.39165
277
278      sob(1,2) =  -0.143566
279      sob(2,2) =   0.091015
280      sob(3,2) =  -0.0153924
281
282      ! schmidt number
283      sca(1,2) =  3845.4 
284      sca(2,2) =  -228.95
285      sca(3,2) =  6.1908 
286      sca(4,2) =  -0.067430
287
288      !IF( ln_rsttr ) THEN
289      !   IF(lwp) WRITE(numout,*)
290      !   IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
291      !   IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
292      !   !
293      !   DO jn = jp_cfc0, jp_cfc1
294      !      CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
295      !   END DO
296      !ENDIF
297      IF(lwp) WRITE(numout,*)
298      !
299   END SUBROUTINE cfc_init
300
301
302   INTEGER FUNCTION trc_sms_cfc_alloc()
303      !!----------------------------------------------------------------------
304      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
305      !!----------------------------------------------------------------------
306      ALLOCATE( xphem   (jpi,jpj)        ,     &
307         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
308         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc )
309         !
310      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
311      !
312   END FUNCTION trc_sms_cfc_alloc
313
314#else
315   !!----------------------------------------------------------------------
316   !!   Dummy module                                         No CFC tracers
317   !!----------------------------------------------------------------------
318CONTAINS
319   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
320      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
321   END SUBROUTINE trc_sms_cfc
322#endif
323
324   !!======================================================================
325END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.