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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcsms_cfc.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcsms_cfc.F90

    r10425 r13463  
    4747   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    4848 
     49   !! * Substitutions 
     50#  include "do_loop_substitute.h90" 
     51#  include "domzgr_substitute.h90" 
    4952   !!---------------------------------------------------------------------- 
    5053   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    5457CONTAINS 
    5558 
    56    SUBROUTINE trc_sms_cfc( kt ) 
     59   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs ) 
    5760      !!---------------------------------------------------------------------- 
    5861      !!                     ***  ROUTINE trc_sms_cfc  *** 
     
    7073      !!                CFC concentration in pico-mol/m3 
    7174      !!---------------------------------------------------------------------- 
    72       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    7377      ! 
    7478      INTEGER  ::   ji, jj, jn, jl, jm 
     
    105109         im2       =      nmonth - 7 
    106110      ENDIF 
     111      ! Avoid bad interpolation if starting date is =< 1900 
     112      IF( iyear_beg .LE. 0      )  iyear_beg = 1 
     113      IF( iyear_beg .GE. jpyear )  iyear_beg = jpyear - 1 
     114      ! 
    107115      iyear_end = iyear_beg + 1 
    108116 
     
    118126          
    119127         !                                                         !------------! 
    120          DO jj = 1, jpj                                            !  i-j loop  ! 
    121             DO ji = 1, jpi                                         !------------! 
     128         DO_2D( 1, 1, 1, 1 ) 
    122129  
    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 revised in Wanninkhof (2014) 
    144                zt1  = tsn(ji,jj,1,jp_tem) 
    145                zt2  = zt1 * zt1  
    146                zt3  = zt1 * zt2 
    147                zt4  = zt2 * zt2 
    148                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    149  
    150                !    speed transfert : formulae revised in Wanninkhof (2014) 
    151                zv2     = wndm(ji,jj) * wndm(ji,jj) 
    152                zsch    = zsch / 660. 
    153                zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    154  
    155                ! Input function  : speed *( conc. at equil - concen at surface ) 
    156                ! trn in pico-mol/l idem qtr; ak in en m/a 
    157                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    158                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    159                ! Add the surface flux to the trend 
    160                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
    161  
    162                ! cumulation of surface flux at each time step 
    163                qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
    164                !                                               !----------------! 
    165             END DO                                             !  end i-j loop  ! 
    166          END DO                                                !----------------! 
     130            ! space interpolation 
     131            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
     132               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
     133 
     134            ! Computation of concentration at equilibrium : in picomol/l 
     135            ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
     136            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
     137               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
     138               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
     139               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
     140                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
     141            ELSE 
     142               zsol  = 0.e0 
     143            ENDIF 
     144            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
     145            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
     146            ! concentration at equilibrium 
     147            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
     148            ! Computation of speed transfert 
     149            !    Schmidt number revised in Wanninkhof (2014) 
     150            zt1  = ts(ji,jj,1,jp_tem,Kmm) 
     151            zt2  = zt1 * zt1  
     152            zt3  = zt1 * zt2 
     153            zt4  = zt2 * zt2 
     154            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     155 
     156            !    speed transfert : formulae revised in Wanninkhof (2014) 
     157            zv2     = wndm(ji,jj) * wndm(ji,jj) 
     158            zsch    = zsch / 660. 
     159            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     160 
     161            ! Input function  : speed *( conc. at equil - concen at surface ) 
     162            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
     163            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
     164               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
     165            ! Add the surface flux to the trend 
     166            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
     167 
     168            ! cumulation of surface flux at each time step 
     169            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt 
     170            !                                               !----------------! 
     171         END_2D 
    167172         !                                                  !----------------! 
    168173      END DO                                                !  end CFC loop  ! 
     
    191196      IF( l_trdtrc ) THEN 
    192197          DO jn = jp_cfc0, jp_cfc1 
    193             CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     198            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    194199          END DO 
    195200      END IF 
     
    293298         DO jn = jp_cfc0, jp_cfc1 
    294299            jl = jl + 1 
    295             CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
     300            CALL iom_get( numrtr, jpdom_auto, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
    296301         END DO 
    297302      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.