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.
Changeset 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 – NEMO

Ignore:
Timestamp:
2016-11-30T17:56:53+01:00 (8 years ago)
Author:
timgraham
Message:

Merge dev_INGV_METO_merge_2016 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6140 r7403  
    77   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity 
    88   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_cfc 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_cfc'                                               CFC tracers 
     9   !!            4.0  !  2016-11  (T. Lovato) Add SF6, Update Schmidt number 
    1310   !!---------------------------------------------------------------------- 
    1411   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
    … …  
    2926 
    3027   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    31    INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
     28   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc) 
    3229   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    3330   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3431   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
    3532    
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for all CFC 
    3734   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm 
    3835   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
    3936   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC 
    4038   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4139 
    42    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    43    REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
     40   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm] 
     41   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               " 
     42   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius 
    4543       
    4644   !                          ! coefficients for conversion 
    … …  
    7977      INTEGER  ::   im1, im2, ierr 
    8078      REAL(wp) ::   ztap, zdtap         
    81       REAL(wp) ::   zt1, zt2, zt3, zv2 
     79      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8280      REAL(wp) ::   zsol      ! solubility 
    8381      REAL(wp) ::   zsch      ! schmidt number  
    … …  
    117115         ! time interpolation at time kt 
    118116         DO jm = 1, jphem 
    119             zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  & 
    120                &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 
     117            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  & 
     118               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. 
    121119         END DO 
    122120          
    … …  
    145143   
    146144               ! Computation of speed transfert 
    147                !    Schmidt number 
     145               !    Schmidt number revised in Wanninkhof (2014) 
    148146               zt1  = tsn(ji,jj,1,jp_tem) 
    149147               zt2  = zt1 * zt1  
    150148               zt3  = zt1 * zt2 
    151                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
    152  
    153                !    speed transfert : formulae of wanninkhof 1992 
     149               zt4  = zt2 * zt2 
     150               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     151 
     152               !    speed transfert : formulae revised in Wanninkhof (2014) 
    154153               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    155154               zsch    = zsch / 660. 
    156                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     155               zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    157156 
    158157               ! Input function  : speed *( conc. at equil - concen at surface ) 
    159158               ! trn in pico-mol/l idem qtr; ak in en m/a 
    160159               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    161 #if defined key_degrad 
    162                   &                         * facvol(ji,jj,1)                           & 
    163 #endif 
    164160                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    165161               ! Add the surface flux to the trend 
    … …  
    185181      ! 
    186182      IF( lk_iomput ) THEN 
    187          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    188          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    189       ELSE 
    190          IF( ln_diatrc ) THEN 
    191             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    192             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    193          END IF 
     183         DO jn = jp_cfc0, jp_cfc1 
     184            CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) ) 
     185            CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     186         ENDDO 
    194187      END IF 
    195188      ! 
    … …  
    212205      !!--------------------------------------------------------------------- 
    213206      INTEGER :: jn 
    214  
     207      !!---------------------------------------------------------------------- 
     208      ! 
     209      jn = 0  
    215210      ! coefficient for CFC11  
    216211      !---------------------- 
    217  
    218       ! Solubility 
    219       soa(1,1) = -229.9261  
    220       soa(2,1) =  319.6552 
    221       soa(3,1) =  119.4471 
    222       soa(4,1) =  -1.39165 
    223  
    224       sob(1,1) =  -0.142382 
    225       sob(2,1) =   0.091459 
    226       sob(3,1) =  -0.0157274 
    227  
    228       ! Schmidt number  
    229       sca(1,1) = 3501.8 
    230       sca(2,1) = -210.31 
    231       sca(3,1) =  6.1851 
    232       sca(4,1) = -0.07513 
     212      if ( ln_cfc11 ) then 
     213         jn = jn + 1 
     214         ! Solubility 
     215         soa(1,jn) = -229.9261  
     216         soa(2,jn) =  319.6552 
     217         soa(3,jn) =  119.4471 
     218         soa(4,jn) =  -1.39165 
     219 
     220         sob(1,jn) =  -0.142382 
     221         sob(2,jn) =   0.091459 
     222         sob(3,jn) =  -0.0157274 
     223 
     224         ! Schmidt number  
     225         sca(1,jn) = 3579.2 
     226         sca(2,jn) = -222.63 
     227         sca(3,jn) = 7.5749 
     228         sca(4,jn) = -0.14595 
     229         sca(5,jn) = 0.0011874 
     230 
     231         ! atm. concentration 
     232         atm_cfc(:,:,jn) = p_cfc(:,:,1) 
     233      endif 
    233234 
    234235      ! coefficient for CFC12  
    235236      !---------------------- 
    236  
    237       ! Solubility 
    238       soa(1,2) = -218.0971 
    239       soa(2,2) =  298.9702 
    240       soa(3,2) =  113.8049 
    241       soa(4,2) =  -1.39165 
    242  
    243       sob(1,2) =  -0.143566 
    244       sob(2,2) =   0.091015 
    245       sob(3,2) =  -0.0153924 
    246  
    247       ! schmidt number  
    248       sca(1,2) =  3845.4  
    249       sca(2,2) =  -228.95 
    250       sca(3,2) =  6.1908  
    251       sca(4,2) =  -0.067430 
     237      if ( ln_cfc12 ) then 
     238         jn = jn + 1 
     239         ! Solubility 
     240         soa(1,jn) = -218.0971 
     241         soa(2,jn) =  298.9702 
     242         soa(3,jn) =  113.8049 
     243         soa(4,jn) =  -1.39165 
     244 
     245         sob(1,jn) =  -0.143566 
     246         sob(2,jn) =   0.091015 
     247         sob(3,jn) =  -0.0153924 
     248 
     249         ! schmidt number  
     250         sca(1,jn) = 3828.1 
     251         sca(2,jn) = -249.86 
     252         sca(3,jn) = 8.7603 
     253         sca(4,jn) = -0.1716 
     254         sca(5,jn) = 0.001408 
     255 
     256         ! atm. concentration 
     257         atm_cfc(:,:,jn) = p_cfc(:,:,2) 
     258      endif 
     259 
     260      ! coefficient for SF6 
     261      !---------------------- 
     262      if ( ln_sf6 ) then 
     263         jn = jn + 1 
     264         ! Solubility 
     265         soa(1,jn) = -80.0343 
     266         soa(2,jn) = 117.232 
     267         soa(3,jn) =  29.5817 
     268         soa(4,jn) =   0.0 
     269 
     270         sob(1,jn) =  0.0335183  
     271         sob(2,jn) = -0.0373942  
     272         sob(3,jn) =  0.00774862 
     273 
     274         ! schmidt number 
     275         sca(1,jn) = 3177.5 
     276         sca(2,jn) = -200.57 
     277         sca(3,jn) = 6.8865 
     278         sca(4,jn) = -0.13335 
     279         sca(5,jn) = 0.0010877 
     280   
     281         ! atm. concentration 
     282         atm_cfc(:,:,jn) = p_cfc(:,:,3) 
     283       endif 
    252284 
    253285      IF( ln_rsttr ) THEN 
    … …  
    269301      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    270302      !!---------------------------------------------------------------------- 
    271       ALLOCATE( xphem   (jpi,jpj)        ,     & 
    272          &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
    273          &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     303      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    & 
     304         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    & 
     305         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    & 
     306         &      STAT=trc_sms_cfc_alloc ) 
    274307         ! 
    275308      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
    … …  
    277310   END FUNCTION trc_sms_cfc_alloc 
    278311 
    279 #else 
    280    !!---------------------------------------------------------------------- 
    281    !!   Dummy module                                         No CFC tracers 
    282    !!---------------------------------------------------------------------- 
    283 CONTAINS 
    284    SUBROUTINE trc_sms_cfc( kt )       ! Empty routine 
    285       WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt 
    286    END SUBROUTINE trc_sms_cfc 
    287 #endif 
    288  
    289312   !!====================================================================== 
    290313END MODULE trcsms_cfc 
Note: See TracChangeset for help on using the changeset viewer.