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 8353 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 – NEMO

Ignore:
Timestamp:
2017-07-19T16:41:00+02:00 (7 years ago)
Author:
lovato
Message:

3.6 stable: update TOP modules and shared configuraton files for CMIP6 (#1925)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r4996 r8353  
    2929 
    3030   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    31    INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
     31   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc) 
    3232   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    3333   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3434   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
     35   CHARACTER(len=200), PUBLIC  ::   clnamecfc      ! Input filename of CFCs atm. concentrations 
    3536    
    3637   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC 
     
    3839   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
    3940   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC 
    4042   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4143 
    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 
    45        
     44   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm] 
     45   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               " 
     46   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius 
    4647   !                          ! coefficients for conversion 
    4748   REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
     
    8283      INTEGER  ::   im1, im2, ierr 
    8384      REAL(wp) ::   ztap, zdtap         
    84       REAL(wp) ::   zt1, zt2, zt3, zv2 
     85      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8586      REAL(wp) ::   zsol      ! solubility 
    8687      REAL(wp) ::   zsch      ! schmidt number  
     
    120121         ! time interpolation at time kt 
    121122         DO jm = 1, jphem 
    122             zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  & 
    123                &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 
     123            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  & 
     124               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. 
    124125         END DO 
    125126          
     
    148149   
    149150               ! Computation of speed transfert 
    150                !    Schmidt number 
     151               !    Schmidt number revised in Wanninkhof (2014) 
    151152               zt1  = tsn(ji,jj,1,jp_tem) 
    152153               zt2  = zt1 * zt1  
    153154               zt3  = zt1 * zt2 
    154                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
    155  
    156                !    speed transfert : formulae of wanninkhof 1992 
     155               zt4  = zt2 * zt2 
     156               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     157 
     158               !    speed transfert : formulae revised in Wanninkhof (2014) 
    157159               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    158160               zsch    = zsch / 660. 
    159                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     161               zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    160162 
    161163               ! Input function  : speed *( conc. at equil - concen at surface ) 
     
    188190      ! 
    189191      IF( lk_iomput ) THEN 
    190          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    191          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     192         DO jn = jp_cfc0, jp_cfc1 
     193            CALL iom_put( 'qtr_'//TRIM(ctrcnm(jn)) , qtr_cfc (:,:,jn) ) 
     194            CALL iom_put( 'qint_'//TRIM(ctrcnm(jn)), qint_cfc(:,:,jn) ) 
     195         ENDDO 
    192196      ELSE 
    193197         IF( ln_diatrc ) THEN 
    194             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    195             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
     198            jl = 0 
     199            DO jn = jp_cfc0_2d, jp_cfc1_2d, 2 
     200               jl = jl + 1 
     201               trc2d(:,:,jn    ) = qtr_cfc (:,:,jl) 
     202               trc2d(:,:,jn + 1) = qint_cfc(:,:,jl) 
     203            ENDDO 
    196204         END IF 
    197205      END IF 
     
    215223      !!--------------------------------------------------------------------- 
    216224      INTEGER :: jn 
    217  
     225      !!---------------------------------------------------------------------- 
     226      ! 
     227      jn = 0  
    218228      ! coefficient for CFC11  
    219229      !---------------------- 
    220  
    221       ! Solubility 
    222       soa(1,1) = -229.9261  
    223       soa(2,1) =  319.6552 
    224       soa(3,1) =  119.4471 
    225       soa(4,1) =  -1.39165 
    226  
    227       sob(1,1) =  -0.142382 
    228       sob(2,1) =   0.091459 
    229       sob(3,1) =  -0.0157274 
    230  
    231       ! Schmidt number  
    232       sca(1,1) = 3501.8 
    233       sca(2,1) = -210.31 
    234       sca(3,1) =  6.1851 
    235       sca(4,1) = -0.07513 
     230      if ( lp_cfc11 ) then 
     231         jn = jn + 1 
     232         ! Solubility 
     233         soa(1,jn) = -229.9261  
     234         soa(2,jn) =  319.6552 
     235         soa(3,jn) =  119.4471 
     236         soa(4,jn) =  -1.39165 
     237 
     238         sob(1,jn) =  -0.142382 
     239         sob(2,jn) =   0.091459 
     240         sob(3,jn) =  -0.0157274 
     241 
     242         ! Schmidt number  
     243         sca(1,jn) = 3579.2 
     244         sca(2,jn) = -222.63 
     245         sca(3,jn) = 7.5749 
     246         sca(4,jn) = -0.14595 
     247         sca(5,jn) = 0.0011874 
     248 
     249         ! atm. concentration 
     250         atm_cfc(:,:,jn) = p_cfc(:,:,1) 
     251      endif 
    236252 
    237253      ! coefficient for CFC12  
    238254      !---------------------- 
    239  
    240       ! Solubility 
    241       soa(1,2) = -218.0971 
    242       soa(2,2) =  298.9702 
    243       soa(3,2) =  113.8049 
    244       soa(4,2) =  -1.39165 
    245  
    246       sob(1,2) =  -0.143566 
    247       sob(2,2) =   0.091015 
    248       sob(3,2) =  -0.0153924 
    249  
    250       ! schmidt number  
    251       sca(1,2) =  3845.4  
    252       sca(2,2) =  -228.95 
    253       sca(3,2) =  6.1908  
    254       sca(4,2) =  -0.067430 
     255      if ( lp_cfc12 ) then 
     256         jn = jn + 1 
     257         ! Solubility 
     258         soa(1,jn) = -218.0971 
     259         soa(2,jn) =  298.9702 
     260         soa(3,jn) =  113.8049 
     261         soa(4,jn) =  -1.39165 
     262 
     263         sob(1,jn) =  -0.143566 
     264         sob(2,jn) =   0.091015 
     265         sob(3,jn) =  -0.0153924 
     266 
     267         ! schmidt number  
     268         sca(1,jn) = 3828.1 
     269         sca(2,jn) = -249.86 
     270         sca(3,jn) = 8.7603 
     271         sca(4,jn) = -0.1716 
     272         sca(5,jn) = 0.001408 
     273 
     274         ! atm. concentration 
     275         atm_cfc(:,:,jn) = p_cfc(:,:,2) 
     276      endif 
     277 
     278      ! coefficient for SF6 
     279      !---------------------- 
     280      if ( lp_sf6 ) then 
     281         jn = jn + 1 
     282         ! Solubility 
     283         soa(1,jn) = -80.0343 
     284         soa(2,jn) = 117.232 
     285         soa(3,jn) =  29.5817 
     286         soa(4,jn) =   0.0 
     287 
     288         sob(1,jn) =  0.0335183  
     289         sob(2,jn) = -0.0373942  
     290         sob(3,jn) =  0.00774862 
     291 
     292         ! schmidt number 
     293         sca(1,jn) = 3177.5 
     294         sca(2,jn) = -200.57 
     295         sca(3,jn) = 6.8865 
     296         sca(4,jn) = -0.13335 
     297         sca(5,jn) = 0.0010877 
     298   
     299         ! atm. concentration 
     300         atm_cfc(:,:,jn) = p_cfc(:,:,3) 
     301       endif 
    255302 
    256303      IF( ln_rsttr ) THEN 
     
    272319      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    273320      !!---------------------------------------------------------------------- 
    274       ALLOCATE( xphem   (jpi,jpj)        ,     & 
    275          &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
    276          &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     321      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    & 
     322         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    & 
     323         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    & 
     324         &      STAT=trc_sms_cfc_alloc ) 
    277325         ! 
    278326      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
Note: See TracChangeset for help on using the changeset viewer.