Changeset 10985


Ignore:
Timestamp:
2019-05-15T21:19:35+02:00 (17 months ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : interface changes to tra and trc routines for design compliance and consistency. Fully SETTE tested (non-AGRIF, only)

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

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbc.F90

    r10954 r10985  
    5151CONTAINS 
    5252 
    53    SUBROUTINE tra_bbc( kt, Kmm, Krhs ) 
     53   SUBROUTINE tra_bbc( kt, Kmm, pts, Krhs ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_bbc  *** 
     
    7373      !!              Emile-Geay and Madec, 2009, Ocean Science. 
    7474      !!---------------------------------------------------------------------- 
    75       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    76       INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices 
     75      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
     76      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    7778      ! 
    7879      INTEGER  ::   ji, jj    ! dummy loop indices 
     
    8485      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    8586         ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    86          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 
     87         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    8788      ENDIF 
    8889      !                             !  Add the geothermal trend on temperature 
    8990      DO jj = 2, jpjm1 
    9091         DO ji = 2, jpim1 
    91             ts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = ts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm) 
     92            pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm) 
    9293         END DO 
    9394      END DO 
    9495      ! 
    95       CALL lbc_lnk( 'trabbc', ts(:,:,:,jp_tem,Krhs) , 'T', 1. ) 
     96      CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1. ) 
    9697      ! 
    9798      IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
    98          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     99         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    99100         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    100101         DEALLOCATE( ztrdt ) 
    101102      ENDIF 
    102103      ! 
    103       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
     104      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    104105      ! 
    105106      IF( ln_timing )   CALL timing_stop('tra_bbc') 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90

    r10954 r10985  
    8989 
    9090 
    91    SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs ) 
     91   SUBROUTINE tra_bbl( kt, Kbb, Kmm, pts, Krhs ) 
    9292      !!---------------------------------------------------------------------- 
    9393      !!                  ***  ROUTINE bbl  *** 
     
    101101      !!              is added to the general tracer trend 
    102102      !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    104       INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices 
     103      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step 
     104      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     105      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    105106      ! 
    106107      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     
    111112      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    112113         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    113          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 
    114          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 
     114         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     115         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    115116      ENDIF 
    116117 
     
    119120      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    120121         ! 
    121          CALL tra_bbl_dif( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 
     122         CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
    122123         IF( ln_ctl )  & 
    123          CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    124             &          tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     124         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
     125            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    125126         ! lateral boundary conditions ; just need for outputs 
    126127         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) 
     
    132133      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    133134         ! 
    134          CALL tra_bbl_adv( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 
     135         CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
    135136         IF(ln_ctl)   & 
    136          CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    137             &          tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     137         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
     138            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    138139         ! lateral boundary conditions ; just need for outputs 
    139140         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) 
     
    144145 
    145146      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    146          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    147          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     147         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     148         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    148149         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    149150         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 
     
    156157 
    157158 
    158    SUBROUTINE tra_bbl_dif( ptb, pta, kjpt, Kmm ) 
     159   SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm ) 
    159160      !!---------------------------------------------------------------------- 
    160161      !!                  ***  ROUTINE tra_bbl_dif  *** 
     
    172173      !!      convection is satified) 
    173174      !! 
    174       !! ** Action  :   pta   increased by the bbl diffusive trend 
     175      !! ** Action  :   pt_rhs   increased by the bbl diffusive trend 
    175176      !! 
    176177      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
     
    178179      !!---------------------------------------------------------------------- 
    179180      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    180       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    181       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     181      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
     182      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
    182183      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    183184      ! 
     
    193194            DO ji = 1, jpi 
    194195               ik = mbkt(ji,jj)                             ! bottom T-level index 
    195                zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S 
     196               zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S 
    196197            END DO 
    197198         END DO 
     
    200201            DO ji = 2, jpim1 
    201202               ik = mbkt(ji,jj)                            ! bottom T-level index 
    202                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
    203                   &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
    204                   &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
    205                   &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    206                   &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    207                   &             * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 
     203               pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  & 
     204                  &                + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
     205                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
     206                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
     207                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
     208                  &                * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 
    208209            END DO 
    209210         END DO 
     
    214215 
    215216 
    216    SUBROUTINE tra_bbl_adv( ptb, pta, kjpt, Kmm ) 
     217   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 
    217218      !!---------------------------------------------------------------------- 
    218219      !!                  ***  ROUTINE trc_bbl  *** 
     
    230231      !!---------------------------------------------------------------------- 
    231232      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    232       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    233       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     233      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
     234      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
    234235      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    235236      ! 
     
    254255                  !                                               ! up  -slope T-point (shelf bottom point) 
    255256                  zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 
    256                   ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    257                   pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
     257                  ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
     258                  pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
    258259                  ! 
    259260                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    260261                     zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 
    261                      ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    262                      pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
     262                     ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
     263                     pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
    263264                  END DO 
    264265                  ! 
    265266                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 
    266                   ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    267                   pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     267                  ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
     268                  pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
    268269               ENDIF 
    269270               ! 
     
    276277                  ! up  -slope T-point (shelf bottom point) 
    277278                  zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 
    278                   ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    279                   pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
     279                  ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
     280                  pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
    280281                  ! 
    281282                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    282283                     zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 
    283                      ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    284                      pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
     284                     ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
     285                     pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
    285286                  END DO 
    286287                  !                                               ! down-slope T-point (deep bottom point) 
    287288                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 
    288                   ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    289                   pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     289                  ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
     290                  pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
    290291               ENDIF 
    291292            END DO 
     
    348349         DO ji = 1, jpi 
    349350            ik = mbkt(ji,jj)                             ! bottom T-level index 
    350             zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb)    ! bottom before T and S 
     351            zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 
    351352            zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 
    352353            ! 
    353             zdep(ji,jj) = gdept(ji,jj,ik,Kmm)              ! bottom T-level reference depth 
    354             zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)          ! bottom velocity 
     354            zdep(ji,jj) = gdept(ji,jj,ik,Kmm)            ! bottom T-level reference depth 
     355            zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)      ! bottom velocity 
    355356            zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 
    356357         END DO 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90

    r10954 r10985  
    7272 
    7373 
    74    SUBROUTINE tra_dmp( kt, Kbb, Kmm, Krhs ) 
     74   SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs ) 
    7575      !!---------------------------------------------------------------------- 
    7676      !!                   ***  ROUTINE tra_dmp  *** 
     
    9090      !! ** Action  : - tsa: tracer trends updated with the damping trend 
    9191      !!---------------------------------------------------------------------- 
    92       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    93       INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
     92      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
     93      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    9495      ! 
    9596      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     
    102103      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103104         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    104          ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs)  
     105         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)  
    105106      ENDIF 
    106107      !                           !==  input T-S data at kt  ==! 
     
    114115               DO jj = 2, jpjm1 
    115116                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    116                      ts(ji,jj,jk,jn,Krhs) = ts(ji,jj,jk,jn,Krhs) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - ts(ji,jj,jk,jn,Kbb) ) 
     117                     pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           & 
     118                        &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 
    117119                  END DO 
    118120               END DO 
     
    125127               DO ji = fs_2, fs_jpim1   ! vector opt. 
    126128                  IF( avt(ji,jj,jk) <= avt_c ) THEN 
    127                      ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)   & 
    128                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,Kbb) ) 
    129                      ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs)   & 
    130                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,Kbb) ) 
     129                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     130                        &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     131                     pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     132                        &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    131133                  ENDIF 
    132134               END DO 
     
    139141               DO ji = fs_2, fs_jpim1   ! vector opt. 
    140142                  IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
    141                      ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)   & 
    142                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,Kbb) ) 
    143                      ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs)   & 
    144                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,Kbb) ) 
     143                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     144                        &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 
     145                     pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   & 
     146                        &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 
    145147                  ENDIF 
    146148               END DO 
     
    151153      ! 
    152154      IF( l_trdtra )   THEN       ! trend diagnostic 
    153          ztrdts(:,:,:,:) = ts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 
     155         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 
    154156         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    155157         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
     
    157159      ENDIF 
    158160      !                           ! Control print 
    159       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    160          &                       tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     161      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
     162         &                       tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161163      ! 
    162164      IF( ln_timing )   CALL timing_stop('tra_dmp') 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranpc.F90

    r10954 r10985  
    4242CONTAINS 
    4343 
    44    SUBROUTINE tra_npc( kt, Kmm, Krhs ) 
     44   SUBROUTINE tra_npc( kt, Kmm, Krhs, pts, Kaa ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                  ***  ROUTINE tranpc  *** 
     
    5858      !! References :     Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5959      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    61       INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices 
     60      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step index 
     61      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs, Kaa  ! time level indices 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    6263      ! 
    6364      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    6768      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    6869      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
    69       REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0) 
    70       REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point... 
    71       REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
    72       REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2  
    73       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta 
    74       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
     70      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp             ! acceptance criteria for neutrality (N2==0) 
     71      REAL(wp), DIMENSION(        jpk     )   ::   zvn2         ! vertical profile of N2 at 1 given point... 
     72      REAL(wp), DIMENSION(        jpk,jpts)   ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk     )   ::   zn2          ! N^2  
     74      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)   ::   zab          ! alpha and beta 
     75      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds ! 3D workspace 
    7576      ! 
    7677      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
     
    8586         IF( l_trdtra )   THEN                    !* Save initial after fields 
    8687            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    87             ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)  
    88             ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 
     88            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kaa)  
     89            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kaa) 
    8990         ENDIF 
    9091         ! 
     
    9697         ENDIF 
    9798         ! 
    98          CALL eos_rab( ts(:,:,:,:,Krhs), zab, Kmm )         ! after alpha and beta (given on T-points) 
    99          CALL bn2    ( ts(:,:,:,:,Krhs), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points) 
     99         CALL eos_rab( pts(:,:,:,:,Kaa), zab, Kmm )         ! after alpha and beta (given on T-points) 
     100         CALL bn2    ( pts(:,:,:,:,Kaa), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points) 
    100101         ! 
    101102         inpcc = 0 
     
    106107               IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
    107108                  !                                     ! consider one ocean column  
    108                   zvts(:,jp_tem) = ts(ji,jj,:,jp_tem,Krhs)      ! temperature 
    109                   zvts(:,jp_sal) = ts(ji,jj,:,jp_sal,Krhs)      ! salinity 
     109                  zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa)      ! temperature 
     110                  zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa)      ! salinity 
    110111                  ! 
    111112                  zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha  
     
    287288                  END DO ! DO WHILE ( .NOT. l_column_treated ) 
    288289 
    289                   !! Updating tsa: 
    290                   ts(ji,jj,:,jp_tem,Krhs) = zvts(:,jp_tem) 
    291                   ts(ji,jj,:,jp_sal,Krhs) = zvts(:,jp_sal) 
     290                  !! Updating pts: 
     291                  pts(ji,jj,:,jp_tem,Kaa) = zvts(:,jp_tem) 
     292                  pts(ji,jj,:,jp_sal,Kaa) = zvts(:,jp_sal) 
    292293 
    293294                  !! LB:  Potentially some other global variable beside theta and S can be treated here 
     
    303304         IF( l_trdtra ) THEN         ! send the Non penetrative mixing trends for diagnostic 
    304305            z1_r2dt = 1._wp / (2._wp * rdt) 
    305             ztrdt(:,:,:) = ( ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) ) * z1_r2dt 
    306             ztrds(:,:,:) = ( ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) ) * z1_r2dt 
     306            ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_r2dt 
     307            ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_r2dt 
    307308            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt ) 
    308309            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds ) 
     
    310311         ENDIF 
    311312         ! 
    312          CALL lbc_lnk_multi( 'tranpc', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 
     313         CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 
    313314         ! 
    314315         IF( lwp .AND. l_LB_debug ) THEN 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traqsr.F90

    r10954 r10985  
    7575CONTAINS 
    7676 
    77    SUBROUTINE tra_qsr( kt, Kmm, Krhs ) 
     77   SUBROUTINE tra_qsr( kt, Kmm, pts, Krhs ) 
    7878      !!---------------------------------------------------------------------- 
    7979      !!                  ***  ROUTINE tra_qsr  *** 
     
    101101      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562 
    102102      !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    104       INTEGER, INTENT(in) ::   Kmm, Krhs     ! time level indices 
     103      INTEGER,                                   INTENT(in   ) :: kt            ! ocean time-step 
     104      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs     ! time level indices 
     105      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts           ! active tracers and RHS of tracer equation 
    105106      ! 
    106107      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     
    127128      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    128129         ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    129          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 
     130         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    130131      ENDIF 
    131132      ! 
     
    262263         DO jj = 2, jpjm1        !-----------------------------! 
    263264            DO ji = fs_2, fs_jpim1   ! vector opt. 
    264                ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)   & 
    265                   &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 
     265               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     266                  &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 
    266267            END DO 
    267268         END DO 
     
    296297      ! 
    297298      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    298          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     299         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    299300         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    300301         DEALLOCATE( ztrdt )  
    301302      ENDIF 
    302303      !                       ! print mean trends (used for debugging) 
    303       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
     304      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    304305      ! 
    305306      IF( ln_timing )   CALL timing_stop('tra_qsr') 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trasbc.F90

    r10954 r10985  
    5151CONTAINS 
    5252 
    53    SUBROUTINE tra_sbc ( kt, Kmm, Krhs ) 
     53   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_sbc  *** 
     
    7272      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7373      !!---------------------------------------------------------------------- 
    74       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    75       INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices 
     74      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
     75      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    7677      ! 
    7778      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices   
     
    9192      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    9293         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    93          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 
    94          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 
     94         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     95         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    9596      ENDIF 
    9697      ! 
     
    132133         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell 
    133134            DO ji = fs_2, fs_jpim1   ! vector opt. 
    134                sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * ts(ji,jj,1,jp_tem,Kmm) 
    135                sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * ts(ji,jj,1,jp_sal,Kmm) 
     135               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
     136               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
    136137            END DO 
    137138         END DO                                 !==>> output c./d. term 
    138          IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    139          IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * ts(:,:,1,jp_sal,Kmm) ) 
     139         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
     140         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
    140141      ENDIF 
    141142      ! 
     
    143144         DO jj = 2, jpj 
    144145            DO ji = fs_2, fs_jpim1   ! vector opt.   
    145                ts(ji,jj,1,jn,Krhs) = ts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm) 
     146               pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm) 
    146147            END DO 
    147148         END DO 
     
    174175               DO jk = ikt, ikb - 1 
    175176               ! compute trend 
    176                   ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)                                                & 
    177                      &           + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             & 
    178                      &           * r1_hisf_tbl(ji,jj) 
     177                  pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                      & 
     178                     &                      + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )  & 
     179                     &                      * r1_hisf_tbl(ji,jj) 
    179180               END DO 
    180181    
    181182               ! level partially include in ice shelf boundary layer  
    182183               ! compute trend 
    183                ts(ji,jj,ikb,jp_tem,Krhs) = ts(ji,jj,ikb,jp_tem,Krhs)                                                 & 
    184                   &              + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             & 
    185                   &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
     184               pts(ji,jj,ikb,jp_tem,Krhs) = pts(ji,jj,ikb,jp_tem,Krhs)                                       & 
     185                  &                       + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )    & 
     186                  &                       * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
    186187 
    187188            END DO 
     
    200201                  zdep = zfact / h_rnf(ji,jj) 
    201202                  DO jk = 1, nk_rnf(ji,jj) 
    202                                         ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs)                                 & 
    203                                            &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 
    204                      IF( ln_rnf_sal )   ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs)                                 & 
    205                                            &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep  
     203                                        pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                  & 
     204                                           &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 
     205                     IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  & 
     206                                           &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep  
    206207                  END DO 
    207208               ENDIF 
     
    210211      ENDIF 
    211212 
    212       IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*ts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
    213       IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*ts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
     213      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
     214      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
    214215 
    215216#if defined key_asminc 
     
    225226               DO ji = fs_2, fs_jpim1 
    226227                  ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 
    227                   ts(ji,jj,1,jp_tem,Krhs) = ts(ji,jj,1,jp_tem,Krhs) + ts(ji,jj,1,jp_tem,Kmm) * ztim 
    228                   ts(ji,jj,1,jp_sal,Krhs) = ts(ji,jj,1,jp_sal,Krhs) + ts(ji,jj,1,jp_sal,Kmm) * ztim 
     228                  pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim 
     229                  pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim 
    229230               END DO 
    230231            END DO 
     
    233234               DO ji = fs_2, fs_jpim1 
    234235                  ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) ) 
    235                   ts(ji,jj,:,jp_tem,Krhs) = ts(ji,jj,:,jp_tem,Krhs) + ts(ji,jj,:,jp_tem,Kmm) * ztim 
    236                   ts(ji,jj,:,jp_sal,Krhs) = ts(ji,jj,:,jp_sal,Krhs) + ts(ji,jj,:,jp_sal,Kmm) * ztim 
     236                  pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim 
     237                  pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim 
    237238               END DO   
    238239            END DO   
     
    252253               DO ji = fs_2, fs_jpim1 
    253254                  zdep = 1._wp / e3t(ji,jj,jk,Kmm)  
    254                   ts(ji,jj,jk,jp_tem,Krhs) = ts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep 
    255                   ts(ji,jj,jk,jp_sal,Krhs) = ts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep   
     255                  pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep 
     256                  pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep   
    256257               END DO   
    257258            END DO   
     
    260261 
    261262      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    262          ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    263          ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     263         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     264         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    264265         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    265266         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 
     
    267268      ENDIF 
    268269      ! 
    269       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   & 
    270          &                       tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     270      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   & 
     271         &                       tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    271272      ! 
    272273      IF( ln_timing )   CALL timing_stop('tra_sbc') 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90

    r10980 r10985  
    242242      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    243243         & ln_trainc )   CALL tra_asm_inc   ( kstp, Nbb, Nnn, ts, Nrhs )  ! apply tracer assimilation increment 
    244                          CALL tra_sbc       ( kstp,      Nnn, Nrhs )  ! surface boundary condition 
    245       IF( ln_traqsr  )   CALL tra_qsr       ( kstp,      Nnn, Nrhs )  ! penetrative solar radiation qsr 
    246       IF( ln_trabbc  )   CALL tra_bbc       ( kstp,      Nnn, Nrhs )  ! bottom heat flux 
    247       IF( ln_trabbl  )   CALL tra_bbl       ( kstp, Nbb, Nnn, Nrhs )  ! advective (and/or diffusive) bottom boundary layer scheme 
    248       IF( ln_tradmp  )   CALL tra_dmp       ( kstp, Nbb, Nnn, Nrhs )  ! internal damping trends 
    249       IF( ln_bdy     )   CALL bdy_tra_dmp   ( kstp, Nbb, ts, Nrhs )  ! bdy damping trends 
     244                         CALL tra_sbc       ( kstp,      Nnn, ts, Nrhs )  ! surface boundary condition 
     245      IF( ln_traqsr  )   CALL tra_qsr       ( kstp,      Nnn, ts, Nrhs )  ! penetrative solar radiation qsr 
     246      IF( ln_trabbc  )   CALL tra_bbc       ( kstp,      Nnn, ts, Nrhs )  ! bottom heat flux 
     247      IF( ln_trabbl  )   CALL tra_bbl       ( kstp, Nbb, Nnn, ts, Nrhs )  ! advective (and/or diffusive) bottom boundary layer scheme 
     248      IF( ln_tradmp  )   CALL tra_dmp       ( kstp, Nbb, Nnn, ts, Nrhs )  ! internal damping trends 
     249      IF( ln_bdy     )   CALL bdy_tra_dmp   ( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends 
    250250#if defined key_agrif 
    251251      IF(.NOT. Agrif_Root())  &  
     
    262262!!gm 
    263263                         CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vert. mixing & after tracer   ==> after 
    264       IF( ln_zdfnpc  )   CALL tra_npc( kstp,      Nnn, Nrhs           )  ! update after fields by non-penetrative convection 
     264      IF( ln_zdfnpc  )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection 
    265265 
    266266      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcbbl.F90

    r10966 r10985  
    2020   !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2121   !!---------------------------------------------------------------------- 
    22    USE oce_trc        ! ocean dynamics and active tracers variables 
     22   USE oce_trc        ! ocean dynamics and passive tracers variables 
    2323   USE trc            ! ocean passive tracers variables 
    2424   USE trd_oce        ! trends: ocean variables 
     
    3636CONTAINS 
    3737 
    38    SUBROUTINE trc_bbl( kt, Kbb, Kmm, Krhs ) 
     38   SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                  ***  ROUTINE bbl  *** 
     
    4545      !! 
    4646      !!----------------------------------------------------------------------   
    47       INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    48       INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices 
     47      INTEGER,                                    INTENT( in  ) :: kt              ! ocean time-step  
     48      INTEGER,                                    INTENT( in  ) :: Kbb, Kmm, Krhs  ! time level indices 
     49      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    4950      INTEGER :: jn                   ! loop index 
    5051      CHARACTER (len=22) :: charout 
     
    6162      IF( l_trdtrc )  THEN 
    6263         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 
    63          ztrtrd(:,:,:,:)  = tr(:,:,:,:,Krhs) 
     64         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    6465      ENDIF 
    6566 
     
    6768      IF( nn_bbl_ldf == 1 ) THEN 
    6869         ! 
    69          CALL tra_bbl_dif( tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, Kmm )   
     70         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    7071         IF( ln_ctl )   THEN 
    7172            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    72             CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     73            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    7374         ENDIF 
    7475         ! 
     
    7879      IF( nn_bbl_adv /= 0 ) THEN 
    7980         ! 
    80          CALL tra_bbl_adv( tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, Kmm )   
     81         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    8182         IF( ln_ctl )   THEN 
    8283            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    83             CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     84            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    8485         ENDIF 
    8586         ! 
     
    8889      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    8990        DO jn = 1, jptra 
    90            ztrtrd(:,:,:,jn) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     91           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
    9192           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9293        END DO 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcdmp.F90

    r10966 r10985  
    6363 
    6464 
    65    SUBROUTINE trc_dmp( kt, Kbb, Kmm, Krhs ) 
     65   SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 
    6666      !!---------------------------------------------------------------------- 
    6767      !!                   ***  ROUTINE trc_dmp  *** 
     
    8282      !!              - save the trends ('key_trdmxl_trc') 
    8383      !!---------------------------------------------------------------------- 
    84       INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
    85       INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
     84      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     85      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     86      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    8687      ! 
    8788      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
     
    101102         DO jn = 1, jptra                                           ! tracer loop 
    102103            !                                                       ! =========== 
    103             IF( l_trdtrc ) ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs)    ! save trends  
     104            IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)    ! save trends  
    104105            ! 
    105106            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     
    114115                     DO jj = 2, jpjm1 
    115116                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    116                            tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - tr(ji,jj,jk,jn,Kbb) ) 
     117                           ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
    117118                        END DO 
    118119                     END DO 
     
    124125                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    125126                           IF( avt(ji,jj,jk) <= avt_c )  THEN  
    126                               tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - tr(ji,jj,jk,jn,Kbb) ) 
     127                              ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
    127128                           ENDIF 
    128129                        END DO 
     
    135136                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    136137                           IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
    137                               tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - tr(ji,jj,jk,jn,Kbb) ) 
     138                              ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
    138139                           END IF 
    139140                        END DO 
     
    146147            ! 
    147148            IF( l_trdtrc ) THEN 
    148                ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) -  ztrtrd(:,:,:) 
     149               ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) -  ztrtrd(:,:,:) 
    149150               CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 
    150151            END IF 
     
    160161         WRITE(charout, FMT="('dmp ')") 
    161162         CALL prt_ctl_trc_info(charout) 
    162          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     163         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    163164      ENDIF 
    164165      ! 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcldf.F90

    r10980 r10985  
    5151CONTAINS 
    5252 
    53    SUBROUTINE trc_ldf( kt, Kbb, Kmm, Krhs ) 
     53   SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_ldf  *** 
     
    5858      !! 
    5959      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
    61       INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! ocean time-level index 
     60      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    6263      ! 
    6364      INTEGER            :: ji, jj, jk, jn 
    6465      REAL(wp)           :: zdep 
    6566      CHARACTER (len=22) :: charout 
    66       REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zahu, zahv 
    67       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     67      REAL(wp),          DIMENSION(jpi,jpj,jpk) ::   zahu, zahv 
     68      REAL(wp), POINTER, DIMENSION(:,:,:,:)     ::   ztrtrd 
    6869      !!---------------------------------------------------------------------- 
    6970      ! 
     
    7475      IF( l_trdtrc )  THEN 
    7576         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 
    76          ztrtrd(:,:,:,:)  = tr(:,:,:,:,Krhs) 
     77         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    7778      ENDIF 
    7879      !                                  !* set the lateral diffusivity coef. for passive tracer       
     
    9596      CASE ( np_lap   )                                                                                    ! iso-level laplacian 
    9697         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    97            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs),                  jptra, 1 ) 
     98           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 ) 
    9899      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec) 
    99100         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    100            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 ) 
     101           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    101102      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies) 
    102103         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    103            &                     tr(:,:,:,:,Kbb), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), jptra, 1 ) 
     104           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    104105      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
    105106         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    106            &                     tr(:,:,:,:,Kbb) , tr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
     107           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
    107108      END SELECT 
    108109      ! 
    109110      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    110111        DO jn = 1, jptra 
    111            ztrtrd(:,:,:,jn) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     112           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
    112113           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    113114        END DO 
     
    118119         WRITE(charout, FMT="('ldf ')") 
    119120         CALL prt_ctl_trc_info(charout) 
    120          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     121         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    121122      ENDIF 
    122123      ! 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcrad.F90

    r10966 r10985  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_rad( kt, Kbb, Kmm, Krhs ) 
     39   SUBROUTINE trc_rad( kt, Kbb, Kmm, Krhs, ptr ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  ROUTINE trc_rad  *** 
     
    5252      !!                (the total CFC content is not strictly preserved) 
    5353      !!---------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
    55       INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
     54      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     55      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     56      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    5657      ! 
    5758      CHARACTER (len=22) :: charout 
     
    6061      IF( ln_timing )   CALL timing_start('trc_rad') 
    6162      ! 
    62       IF( ln_age     )   CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), jp_age , jp_age                )  !  AGE 
    63       IF( ll_cfc     )   CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), jp_cfc0, jp_cfc1               )  !  CFC model 
    64       IF( ln_c14     )   CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), jp_c14 , jp_c14                )  !  C14 
    65       IF( ln_pisces  )   CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
    66       IF( ln_my_trc  )   CALL trc_rad_sms( kt, Kmm, Krhs, tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), jp_myt0, jp_myt1               )  !  MY_TRC model 
     63      IF( ln_age     )   CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_age , jp_age                )  !  AGE 
     64      IF( ll_cfc     )   CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_cfc0, jp_cfc1               )  !  CFC model 
     65      IF( ln_c14     )   CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_c14 , jp_c14                )  !  C14 
     66      IF( ln_pisces  )   CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
     67      IF( ln_my_trc  )   CALL trc_rad_sms( kt, Kmm, Krhs, ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kmm), jp_myt0, jp_myt1               )  !  MY_TRC model 
    6768      ! 
    6869      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    6970         WRITE(charout, FMT="('rad')") 
    7071         CALL prt_ctl_trc_info( charout ) 
    71          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     72         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    7273      ENDIF 
    7374      ! 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcsbc.F90

    r10966 r10985  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_sbc ( kt, Kmm, Krhs ) 
     39   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  ROUTINE trc_sbc  *** 
     
    5858      !! 
    5959      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    61       INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices 
     60      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    6263      ! 
    6364      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
     
    119120            DO jj = 2, jpj 
    120121               DO ji = fs_2, fs_jpim1   ! vector opt. 
    121                   sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * tr(ji,jj,1,jn,Kmm) 
     122                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
    122123               END DO 
    123124            END DO 
     
    138139                  ztfx  = zftra                             ! net tracer flux 
    139140                  ! 
    140                   zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * tr(ji,jj,1,jn,Kmm) )  
     141                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * ptr(ji,jj,1,jn,Kmm) )  
    141142                  IF ( zdtra < 0. ) THEN 
    142                      zratio = -zdtra * zse3t * r2dttrc / ( tr(ji,jj,1,jn,Kmm) + zrtrn ) 
     143                     zratio = -zdtra * zse3t * r2dttrc / ( ptr(ji,jj,1,jn,Kmm) + zrtrn ) 
    143144                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
    144145                  ENDIF 
     
    153154      DO jn = 1, jptra 
    154155         ! 
    155          IF( l_trdtrc )   ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs)  ! save trends 
     156         IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)  ! save trends 
    156157         ! 
    157158         DO jj = 2, jpj 
    158159            DO ji = fs_2, fs_jpim1   ! vector opt. 
    159160               zse3t = zfact / e3t(ji,jj,1,Kmm) 
    160                tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
     161               ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    161162            END DO 
    162163         END DO 
    163164         ! 
    164165         IF( l_trdtrc ) THEN 
    165             ztrtrd(:,:,:) = tr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 
     166            ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 
    166167            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 
    167168         END IF 
     
    184185      IF( ln_ctl )   THEN 
    185186         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    186                                            CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     187                                           CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    187188      ENDIF 
    188189      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
     
    197198   !!---------------------------------------------------------------------- 
    198199CONTAINS 
    199    SUBROUTINE trc_sbc (kt)              ! Empty routine 
    200       INTEGER, INTENT(in) :: kt 
     200   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs )      ! Empty routine 
     201      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     202      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     203      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    201204      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 
    202205   END SUBROUTINE trc_sbc 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trctrp.F90

    r10966 r10985  
    6161      IF( .NOT. lk_c1d ) THEN 
    6262         ! 
    63                                 CALL trc_sbc    ( kt,      Kmm, Krhs )      ! surface boundary condition 
    64          IF( ln_trabbl )        CALL trc_bbl    ( kt, Kbb, Kmm, Krhs )      ! advective (and/or diffusive) bottom boundary layer scheme 
    65          IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, Krhs )      ! internal damping trends 
     63                                CALL trc_sbc    ( kt,      Kmm, tr, Krhs )  ! surface boundary condition 
     64         IF( ln_trabbl )        CALL trc_bbl    ( kt, Kbb, Kmm, tr, Krhs )  ! advective (and/or diffusive) bottom boundary layer scheme 
     65         IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, tr, Krhs )  ! internal damping trends 
    6666         IF( ln_bdy )           CALL trc_bdy_dmp( kt, Kbb,      Krhs )      ! BDY damping trends 
    6767                                CALL trc_adv    ( kt, Kbb, Kmm, tr, Krhs )  ! horizontal & vertical advection  
     
    7373         ENDIF 
    7474         !                                                       
    75                                 CALL trc_ldf    ( kt, Kbb, Kmm, Krhs )     ! lateral mixing 
     75                                CALL trc_ldf    ( kt, Kbb, Kmm,       tr, Krhs )  ! lateral mixing 
    7676#if defined key_agrif 
    7777         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
     
    7979                                CALL trc_zdf    ( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer   ==> after 
    8080                                CALL trc_nxt    ( kt, Kbb, Kmm, Krhs )            ! tracer fields at next time step      
    81          IF( ln_trcrad )        CALL trc_rad    ( kt, Kbb, Kmm, Krhs )            ! Correct artificial negative concentrations 
     81         IF( ln_trcrad )        CALL trc_rad    ( kt, Kbb, Kmm, Krhs, tr       )  ! Correct artificial negative concentrations 
    8282         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt, Kbb, Kmm )                  ! internal damping trends on closed seas only 
    8383 
    8484         ! 
    8585      ELSE                                               ! 1D vertical configuration 
    86                                 CALL trc_sbc( kt,      Kmm, Krhs )            ! surface boundary condition 
    87          IF( ln_trcdmp )        CALL trc_dmp( kt, Kbb, Kmm, Krhs )            ! internal damping trends 
     86                                CALL trc_sbc( kt,      Kmm,       tr, Krhs )  ! surface boundary condition 
     87         IF( ln_trcdmp )        CALL trc_dmp( kt, Kbb, Kmm,       tr, Krhs )  ! internal damping trends 
    8888                                CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer ==> after 
    8989                                CALL trc_nxt( kt, Kbb, Kmm, Krhs )            ! tracer fields at next time step      
    90           IF( ln_trcrad )       CALL trc_rad( kt, Kbb, Kmm, Krhs )            ! Correct artificial negative concentrations 
     90          IF( ln_trcrad )       CALL trc_rad( kt, Kbb, Kmm, Krhs, tr       )  ! Correct artificial negative concentrations 
    9191         ! 
    9292      END IF 
Note: See TracChangeset for help on using the changeset viewer.