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 10806 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90 – NEMO

Ignore:
Timestamp:
2019-03-27T17:55:22+01:00 (5 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps branch: Latest updates. Make sure all time-dependent 3D variables are converted in previously modified modules.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90

    r10425 r10806  
    8989 
    9090 
    91    SUBROUTINE tra_bbl( kt ) 
     91   SUBROUTINE tra_bbl( kt, ktlev1, ktlev2, kt2lev, pts_rhs ) 
    9292      !!---------------------------------------------------------------------- 
    9393      !!                  ***  ROUTINE bbl  *** 
    … …  
    101101      !!              is added to the general tracer trend 
    102102      !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
     103      INTEGER, INTENT( in ) ::   kt              ! ocean time-step 
     104      INTEGER, INTENT( in ) ::   ktlev1, ktlev2  ! time level indices for 3-time-level source terms 
     105      INTEGER, INTENT( in ) ::   kt2lev          ! time level index for 2-time-level source terms 
     106      REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
    104107      ! 
    105108      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    110113      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    111114         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    112          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    113          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    114       ENDIF 
    115  
    116       IF( l_bbl )   CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
     115         ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) 
     116         ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) 
     117      ENDIF 
     118 
     119      IF( l_bbl )   CALL bbl( kt, nit000, ktlev1, ktlev2, kt2lev, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
    117120 
    118121      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    119122         ! 
    120          CALL tra_bbl_dif( tsb, tsa, jpts ) 
     123         CALL tra_bbl_dif( ts(:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts ) 
    121124         IF( ln_ctl )  & 
    122125         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    … …  
    131134      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    132135         ! 
    133          CALL tra_bbl_adv( tsb, tsa, jpts ) 
     136         CALL tra_bbl_adv( ts(:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts ) 
    134137         IF(ln_ctl)   & 
    135138         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    … …  
    143146 
    144147      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    145          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    146          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     148         ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:) 
     149         ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) - ztrds(:,:,:) 
    147150         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    148151         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    … …  
    155158 
    156159 
    157    SUBROUTINE tra_bbl_dif( ptb, pta, kjpt ) 
     160   SUBROUTINE tra_bbl_dif( pt, pe3t, pt_rhs, kjpt ) 
    158161      !!---------------------------------------------------------------------- 
    159162      !!                  ***  ROUTINE tra_bbl_dif  *** 
    … …  
    171174      !!      convection is satified) 
    172175      !! 
    173       !! ** Action  :   pta   increased by the bbl diffusive trend 
     176      !! ** Action  :   pt_rhs   increased by the bbl diffusive trend 
    174177      !! 
    175178      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    … …  
    177180      !!---------------------------------------------------------------------- 
    178181      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    179       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    180       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     182      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! tracer fields 
     183      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pe3t   ! thickness fields 
     184      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
    181185      ! 
    182186      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    191195            DO ji = 1, jpi 
    192196               ik = mbkt(ji,jj)                             ! bottom T-level index 
    193                zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S 
     197               zptb(ji,jj) = pt(ji,jj,ik,jn)               ! bottom before T and S 
    194198            END DO 
    195199         END DO 
    … …  
    198202            DO ji = 2, jpim1 
    199203               ik = mbkt(ji,jj)                            ! bottom T-level index 
    200                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
     204               pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  & 
    201205                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
    202206                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
    203207                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    204208                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    205                   &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 
     209                  &             * r1_e1e2t(ji,jj) / pe3t(ji,jj,ik) 
    206210            END DO 
    207211         END DO 
    … …  
    212216 
    213217 
    214    SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 
     218   SUBROUTINE tra_bbl_adv( pt, pe3t, pt_rhs, kjpt ) 
    215219      !!---------------------------------------------------------------------- 
    216220      !!                  ***  ROUTINE trc_bbl  *** 
    … …  
    228232      !!---------------------------------------------------------------------- 
    229233      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    230       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    231       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     234      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt    ! before and now tracer fields 
     235      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pe3t   ! thickness fields 
     236      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs    ! tracer trend 
    232237      ! 
    233238      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    … …  
    250255                  ! 
    251256                  !                                               ! up  -slope T-point (shelf bottom point) 
    252                   zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 
    253                   ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    254                   pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
     257                  zbtr = r1_e1e2t(iis,jj) / pe3t(iis,jj,ikus) 
     258                  ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
     259                  pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
    255260                  ! 
    256261                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    257                      zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 
    258                      ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    259                      pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
     262                     zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,jk) 
     263                     ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
     264                     pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
    260265                  END DO 
    261266                  ! 
    262                   zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 
    263                   ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    264                   pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     267                  zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,ikud) 
     268                  ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
     269                  pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
    265270               ENDIF 
    266271               ! 
    … …  
    272277                  ! 
    273278                  ! up  -slope T-point (shelf bottom point) 
    274                   zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 
    275                   ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    276                   pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
     279                  zbtr = r1_e1e2t(ji,ijs) / pe3t(ji,ijs,ikvs) 
     280                  ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
     281                  pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
    277282                  ! 
    278283                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    279                      zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 
    280                      ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    281                      pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
     284                     zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,jk) 
     285                     ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
     286                     pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
    282287                  END DO 
    283288                  !                                               ! down-slope T-point (deep bottom point) 
    284                   zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 
    285                   ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    286                   pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     289                  zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,ikvd) 
     290                  ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
     291                  pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
    287292               ENDIF 
    288293            END DO 
    … …  
    295300 
    296301 
    297    SUBROUTINE bbl( kt, kit000, cdtype ) 
     302   SUBROUTINE bbl( kt, kit000, ktlev1, ktlev2, kt2lev, cdtype ) 
    298303      !!---------------------------------------------------------------------- 
    299304      !!                  ***  ROUTINE bbl  *** 
    … …  
    323328      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    324329      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index 
     330      INTEGER         , INTENT(in   ) ::   ktlev1, ktlev2  ! time level indices for 3-time-levelsource terms 
     331      INTEGER         , INTENT(in   ) ::   kt2lev          ! time level index for 2-time-level source terms 
    325332      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    326333      ! 
    … …  
    344351         DO ji = 1, jpi 
    345352            ik = mbkt(ji,jj)                             ! bottom T-level index 
    346             zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S 
    347             zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
     353            zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,ktlev1)    ! bottom before T and S 
     354            zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,ktlev1) 
    348355            ! 
    349             zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth 
    350             zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
    351             zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
     356            zdep(ji,jj) = gdept(ji,jj,ik,kt2lev)              ! bottom T-level reference depth 
     357            zub (ji,jj) = uu(ji,jj,mbku(ji,jj),ktlev2)          ! bottom velocity 
     358            zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),ktlev2) 
    352359         END DO 
    353360      END DO 
Note: See TracChangeset for help on using the changeset viewer.