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 10980 – NEMO

Changeset 10980


Ignore:
Timestamp:
2019-05-15T13:34:04+02:00 (5 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : interface changes to traldf routines for design compliance and consistency. SETTE tested (GYRE_PISCES, only)

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
Files:
6 edited

Legend:

Unmodified
Added
Removed

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

    r10954 r10980  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_ldf( kt, Kbb, Kmm, Krhs ) 
     49   SUBROUTINE tra_ldf( kt, Kbb, Kmm, pts, Krhs ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5353      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5454      !!---------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    56       INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! ocean time level indices 
     55      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
     56      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time level indices 
     57      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    5758      !! 
    5859      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    6364      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    6465         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    65          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)  
    66          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 
     66         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)  
     67         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    6768      ENDIF 
    6869      ! 
    6970      SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
    7071      CASE ( np_lap   )                                  ! laplacian: iso-level operator 
    71          CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs),                   jpts,  1, Kmm ) 
     72         CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
    7273      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
    73          CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts,  1, Kmm ) 
     74         CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    7475      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    75          CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts,  1, Kmm ) 
     76         CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    7677      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    77          CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs),             jpts, nldf_tra, Kmm ) 
     78         CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    7879      END SELECT 
    7980      ! 
    8081      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    81          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    82          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     82         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     83         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    8384         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8485         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    … …  
    8687      ENDIF 
    8788      !                                        !* print mean trends (used for debugging) 
    88       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
    89          &                       tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     89      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
     90         &                       tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9091      ! 
    9192      IF( ln_timing )   CALL timing_stop('tra_ldf') 

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

    r10954 r10980  
    4848CONTAINS 
    4949 
    50   SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    51       &                                                   pgui, pgvi,   & 
    52       &                                       ptb , ptbb, pta , kjpt, kpass, Kmm ) 
     50  SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv,                    & 
     51      &                                            pgu , pgv    ,   pgui, pgvi,   & 
     52      &                                       pt , pt2 , pt_rhs , kjpt  , kpass ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_ldf_iso  *** 
    … …  
    8787      !!         difft = 1/(e1e2t*e3t) dk[ zftw ] 
    8888      !!      Add this trend to the general trend (ta,sa): 
    89       !!         pta = pta + difft 
    90       !! 
    91       !! ** Action :   Update pta arrays with the before rotated diffusion 
     89      !!         pt_rhs = pt_rhs + difft 
     90      !! 
     91      !! ** Action :   Update pt_rhs arrays with the before rotated diffusion 
    9292      !!---------------------------------------------------------------------- 
    9393      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    100100      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    101101      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     103      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     104      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    105105      ! 
    106106      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    … …  
    220220            DO jj = 1, jpjm1 
    221221               DO ji = 1, fs_jpim1   ! vector opt. 
    222                   zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    223                   zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     222                  zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     223                  zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    224224               END DO 
    225225            END DO 
    … …  
    249249            ! 
    250250            !                             !== Vertical tracer gradient 
    251             zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
     251            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    252252            ! 
    253253            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    254             ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
     254            ELSE                 ;   zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 
    255255            ENDIF 
    256256            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    … …  
    277277            END DO 
    278278            ! 
    279             DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
     279            DO jj = 2 , jpjm1          !== horizontal divergence and add to pt_rhs 
    280280               DO ji = fs_2, fs_jpim1   ! vector opt. 
    281                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
    282                      &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    283                      &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     281                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
     282                     &                                                 + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
     283                     &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    284284               END DO 
    285285            END DO 
    … …  
    327327                  DO ji = fs_2, fs_jpim1 
    328328                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   & 
    329                         &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    330                         &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     329                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               & 
     330                        &                            * (  pt(ji,jj,jk-1,jn) -  pt(ji,jj,jk,jn) ) 
    331331                  END DO 
    332332               END DO 
    … …  
    339339                  DO jj = 1, jpjm1 
    340340                     DO ji = fs_2, fs_jpim1 
    341                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
    342                            &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    343                            &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
     341                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)                       & 
     342                           &           + ah_wslp2(ji,jj,jk)  * e1e2t(ji,jj)   & 
     343                           &           * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
    344344                     END DO 
    345345                  END DO 
    346346               END DO  
    347             CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     347            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    348348               DO jk = 2, jpkm1  
    349349                  DO jj = 1, jpjm1 
    350350                     DO ji = fs_2, fs_jpim1 
    351                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                      & 
    352                            &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
    353                            &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     351                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  & 
     352                           &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
     353                           &                            +         akz(ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   ) 
    354354                     END DO 
    355355                  END DO 
    … …  
    358358         ENDIF 
    359359         !          
    360          DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
     360         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pt_rhs  ==! 
    361361            DO jj = 2, jpjm1 
    362362               DO ji = fs_2, fs_jpim1   ! vector opt. 
    363                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
    364                      &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     363                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
     364                     &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    365365               END DO 
    366366            END DO 

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

    r10954 r10980  
    4545CONTAINS 
    4646 
    47    SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    48       &                                                   pgui, pgvi,   & 
    49       &                                        ptb , pta , kjpt, kpass, Kmm )  
     47   SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv  ,               & 
     48      &                                             pgu , pgv   , pgui, pgvi,   & 
     49      &                                             pt  , pt_rhs, kjpt, kpass )  
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf_lap  *** 
    … …  
    5959      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
    6060      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
    61       !!      Add this trend to the general tracer trend pta : 
    62       !!          pta = pta + difft 
    63       !! 
    64       !! ** Action  : - Update pta arrays with the before iso-level  
     61      !!      Add this trend to the general tracer trend pt_rhs : 
     62      !!          pt_rhs = pt_rhs + difft 
     63      !! 
     64      !! ** Action  : - Update pt_rhs arrays with the before iso-level  
    6565      !!                harmonic mixing trend. 
    6666      !!---------------------------------------------------------------------- 
    … …  
    7474      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    7575      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before tracer fields 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend  
    7878      ! 
    7979      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    114114            DO jj = 1, jpjm1 
    115115               DO ji = 1, fs_jpim1 
    116                   ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    117                   ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     116                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) 
     117                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
    118118               END DO 
    119119            END DO 
    … …  
    139139            DO jj = 2, jpjm1 
    140140               DO ji = fs_2, fs_jpim1 
    141                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    142                      &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
    143                      &                                / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
     141                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
     142                     &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
     143                     &                                      / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
    144144               END DO 
    145145            END DO 
    … …  
    160160    
    161161 
    162    SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    163       &                                                    pgui, pgvi,  & 
    164       &                                                    ptb , pta , kjpt, kldf, Kmm ) 
     162   SUBROUTINE tra_ldf_blp( kt, Kmm, kit000, cdtype, pahu, pahv  ,             & 
     163      &                                             pgu , pgv   , pgui, pgvi, & 
     164      &                                             pt  , pt_rhs, kjpt, kldf ) 
    165165      !!---------------------------------------------------------------------- 
    166166      !!                 ***  ROUTINE tra_ldf_blp  *** 
    … …  
    184184      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    185185      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels 
    186       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    187       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
     186      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before and now tracer fields 
     187      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    188188      ! 
    189189      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    205205      zlap(:,:,:,:) = 0._wp 
    206206      ! 
    207       SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==! 
     207      SELECT CASE ( kldf )       !==  1st laplacian applied to pt (output in zlap)  ==! 
    208208      ! 
    209209      CASE ( np_blp    )               ! iso-level bilaplacian 
    210          CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1, Kmm ) 
     210         CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt,     zlap, kjpt, 1 ) 
    211211      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
    212          CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1, Kmm ) 
     212         CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 
    213213      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    214          CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1, Kmm ) 
     214         CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 
    215215      END SELECT 
    216216      ! 
    … …  
    221221      ENDIF 
    222222      ! 
    223       SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==! 
     223      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pt_rhs)  ==! 
    224224      ! 
    225225      CASE ( np_blp    )               ! iso-level bilaplacian 
    226          CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2, Kmm ) 
     226         CALL tra_ldf_lap  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs,         kjpt, 2 ) 
    227227      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
    228          CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2, Kmm ) 
     228         CALL tra_ldf_iso  ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 ) 
    229229      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    230          CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2, Kmm ) 
     230         CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt    , pt_rhs, kjpt, 2 ) 
    231231      END SELECT 
    232232      ! 

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

    r10954 r10980  
    4848CONTAINS 
    4949 
    50   SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    51       &                                                     pgui, pgvi,  & 
    52       &                                         ptb , ptbb, pta , kjpt, kpass, Kmm ) 
     50  SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv,               & 
     51      &                                              pgu , pgv  , pgui, pgvi , & 
     52      &                                         pt , pt2, pt_rhs, kjpt, kpass ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_ldf_triad  *** 
    … …  
    6666      !!      see documentation for the desciption 
    6767      !! 
    68       !! ** Action :   pta   updated with the before rotated diffusion 
     68      !! ** Action :   pt_rhs   updated with the before rotated diffusion 
    6969      !!               ah_wslp2 .... 
    7070      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp) 
    … …  
    7979      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
    8080      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    81       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    8484      ! 
    8585      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    … …  
    230230            DO jj = 1, jpjm1 
    231231               DO ji = 1, fs_jpim1   ! vector opt. 
    232                   zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    233                   zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     232                  zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     233                  zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    234234               END DO 
    235235            END DO 
    … …  
    258258         DO jk = 1, jpkm1 
    259259            !                    !==  Vertical tracer gradient at level jk and jk+1 
    260             zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
     260            zdkt3d(:,:,1) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
    261261            ! 
    262262            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 
    263263            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    264             ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
     264            ELSE                 ;   zdkt3d(:,:,0) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk) 
    265265            ENDIF 
    266266            ! 
    … …  
    363363            DO jj = 2 , jpjm1 
    364364               DO ji = fs_2, fs_jpim1  ! vector opt. 
    365                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
     365                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
    366366                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   & 
    367367                     &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  ) 
    … …  
    378378                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    379379                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    380                         &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     380                        &                            * (  pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    381381                  END DO 
    382382               END DO 
    … …  
    389389                     DO ji = fs_2, fs_jpim1 
    390390                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    391                            &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     391                           &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    392392                     END DO 
    393393                  END DO 
    394394               END DO  
    395             CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     395            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    396396               DO jk = 2, jpkm1  
    397397                  DO jj = 1, jpjm1 
    398398                     DO ji = fs_2, fs_jpim1 
    399399                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    400                            &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
    401                            &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     400                           &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
     401                           &                               + akz     (ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   ) 
    402402                     END DO 
    403403                  END DO 
    … …  
    406406         ENDIF 
    407407         ! 
    408          DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
     408         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pt_rhs  ==! 
    409409            DO jj = 2, jpjm1 
    410410               DO ji = fs_2, fs_jpim1  ! vector opt. 
    411                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
    412                      &                                        / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
     411                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
     412                     &                                              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
    413413               END DO 
    414414            END DO 

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

    r10978 r10980  
    256256      IF( lrst_oce .AND. ln_zdfosm ) & 
    257257           &             CALL osm_rst( kstp,      Nnn, 'WRITE' )         ! write OSMOSIS outputs + wn (so must do here) to restarts 
    258                          CALL tra_ldf( kstp, Nbb, Nnn, Nrhs )            ! lateral mixing 
     258                         CALL tra_ldf( kstp, Nbb, Nnn      , ts, Nrhs )  ! lateral mixing 
    259259 
    260260!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcldf.F90

    r10966 r10980  
    9494      ! 
    9595      CASE ( np_lap   )                                                                                    ! iso-level laplacian 
    96          CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,               & 
    97            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs),                 jptra, 1 , Kmm ) 
     96         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     97           &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs),                  jptra, 1 ) 
    9898      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec) 
    99          CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,               & 
    100            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 , Kmm ) 
     99         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     100           &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 ) 
    101101      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies) 
    102          CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,               & 
    103            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 , Kmm ) 
     102         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     103           &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 ) 
    104104      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
    105          CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,               & 
    106            &                     tr(:,:,:,:,Kbb) , tr(:,:,:,:,Krhs),                 jptra, nldf_trc, Kmm ) 
     105         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     106           &                     tr(:,:,:,:,Kbb) , tr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
    107107      END SELECT 
    108108      ! 
Note: See TracChangeset for help on using the changeset viewer.