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

Changeset 10965


Ignore:
Timestamp:
2019-05-10T18:02:51+02:00 (5 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : DIA and stpctl.F90. Just testing in ORCA1 so far.

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

Legend:

Unmodified
Added
Removed

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

    r10068 r10965  
    1414   !!---------------------------------------------------------------------- 
    1515   USE step_oce        ! time stepping definition modules  
     16   USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 
    1617#if defined key_top 
    1718   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    … …  
    8586      ! diagnostics and outputs             (ua, va, ta, sa used as workspace) 
    8687      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    87                          CALL dia_wri( kstp )       ! ocean model: outputs 
    88       IF( lk_diahth  )   CALL dia_hth( kstp )       ! Thermocline depth (20°C) 
     88                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs 
     89      IF( lk_diahth  )   CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
    8990 
    9091 

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

    r10641 r10965  
    3939CONTAINS 
    4040 
    41    SUBROUTINE dia_25h_init  
     41   SUBROUTINE dia_25h_init( Kbb ) 
    4242      !!--------------------------------------------------------------------------- 
    4343      !!                  ***  ROUTINE dia_25h_init  *** 
    … …  
    4747      !! ** Method : Read namelist 
    4848      !!--------------------------------------------------------------------------- 
     49      INTEGER, INTENT(in) :: Kbb       ! Time level index 
     50      ! 
    4951      INTEGER ::   ios                 ! Local integer output status for namelist read 
    5052      INTEGER ::   ierror              ! Local integer for memory allocation 
    … …  
    9597      ! ------------------------- ! 
    9698      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)  
    97       tn_25h  (:,:,:) = tsb (:,:,:,jp_tem) 
    98       sn_25h  (:,:,:) = tsb (:,:,:,jp_sal) 
    99       sshn_25h(:,:)   = sshb(:,:) 
    100       un_25h  (:,:,:) = ub  (:,:,:) 
    101       vn_25h  (:,:,:) = vb  (:,:,:) 
     99      tn_25h  (:,:,:) = ts (:,:,:,jp_tem,Kbb) 
     100      sn_25h  (:,:,:) = ts (:,:,:,jp_sal,Kbb) 
     101      sshn_25h(:,:)   = ssh(:,:,Kbb) 
     102      un_25h  (:,:,:) = uu  (:,:,:,Kbb) 
     103      vn_25h  (:,:,:) = vv  (:,:,:,Kbb) 
    102104      avt_25h (:,:,:) = avt (:,:,:) 
    103105      avm_25h (:,:,:) = avm (:,:,:) 
    … …  
    116118 
    117119 
    118    SUBROUTINE dia_25h( kt )   
     120   SUBROUTINE dia_25h( kt, Kmm )   
    119121      !!---------------------------------------------------------------------- 
    120122      !!                 ***  ROUTINE dia_25h  *** 
    … …  
    125127      !!---------------------------------------------------------------------- 
    126128      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     129      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    127130      !! 
    128131      INTEGER ::   ji, jj, jk 
    … …  
    150153      ! wn_25h could not be initialised in dia_25h_init, so we do it here instead 
    151154      IF( kt == nn_it000 ) THEN 
    152          wn_25h(:,:,:) = wn(:,:,:) 
     155         wn_25h(:,:,:) = ww(:,:,:) 
    153156      ENDIF 
    154157 
    … …  
    161164         ENDIF 
    162165 
    163          tn_25h  (:,:,:)     = tn_25h  (:,:,:) + tsn (:,:,:,jp_tem) 
    164          sn_25h  (:,:,:)     = sn_25h  (:,:,:) + tsn (:,:,:,jp_sal) 
    165          sshn_25h(:,:)       = sshn_25h(:,:)   + sshn(:,:) 
    166          un_25h  (:,:,:)     = un_25h  (:,:,:) + un  (:,:,:) 
    167          vn_25h  (:,:,:)     = vn_25h  (:,:,:) + vn  (:,:,:) 
    168          wn_25h  (:,:,:)     = wn_25h  (:,:,:) + wn  (:,:,:) 
     166         tn_25h  (:,:,:)     = tn_25h  (:,:,:) + ts (:,:,:,jp_tem,Kmm) 
     167         sn_25h  (:,:,:)     = sn_25h  (:,:,:) + ts (:,:,:,jp_sal,Kmm) 
     168         sshn_25h(:,:)       = sshn_25h(:,:)   + ssh(:,:,Kmm) 
     169         un_25h  (:,:,:)     = un_25h  (:,:,:) + uu  (:,:,:,Kmm) 
     170         vn_25h  (:,:,:)     = vn_25h  (:,:,:) + vv  (:,:,:,Kmm) 
     171         wn_25h  (:,:,:)     = wn_25h  (:,:,:) + ww  (:,:,:) 
    169172         avt_25h (:,:,:)     = avt_25h (:,:,:) + avt (:,:,:) 
    170173         avm_25h (:,:,:)     = avm_25h (:,:,:) + avm (:,:,:) 
    … …  
    245248         ! 
    246249         ! After the write reset the values to cnt=1 and sum values equal current value  
    247          tn_25h  (:,:,:) = tsn (:,:,:,jp_tem) 
    248          sn_25h  (:,:,:) = tsn (:,:,:,jp_sal) 
    249          sshn_25h(:,:)   = sshn(:,:) 
    250          un_25h  (:,:,:) = un  (:,:,:) 
    251          vn_25h  (:,:,:) = vn  (:,:,:) 
    252          wn_25h  (:,:,:) = wn  (:,:,:) 
     250         tn_25h  (:,:,:) = ts (:,:,:,jp_tem,Kmm) 
     251         sn_25h  (:,:,:) = ts (:,:,:,jp_sal,Kmm) 
     252         sshn_25h(:,:)   = ssh(:,:,Kmm) 
     253         un_25h  (:,:,:) = uu  (:,:,:,Kmm) 
     254         vn_25h  (:,:,:) = vv  (:,:,:,Kmm) 
     255         wn_25h  (:,:,:) = ww  (:,:,:) 
    253256         avt_25h (:,:,:) = avt (:,:,:) 
    254257         avm_25h (:,:,:) = avm (:,:,:) 

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

    r10425 r10965  
    6262 
    6363 
    64    SUBROUTINE dia_ar5( kt ) 
     64   SUBROUTINE dia_ar5( kt, Kmm ) 
    6565      !!---------------------------------------------------------------------- 
    6666      !!                    ***  ROUTINE dia_ar5  *** 
    … …  
    7070      ! 
    7171      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     72      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    7273      ! 
    7374      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    … …  
    8990         ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
    9091         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    91          zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
     92         zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 
    9293      ENDIF 
    9394      ! 
    … …  
    100101         CALL iom_put( 'voltot', zvol               ) 
    101102         CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    102          CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
     103         CALL iom_put( 'sshdyn', ssh(:,:,Kmm) - (zvolssh / area_tot) ) 
    103104         ! 
    104105      ENDIF 
    … …  
    106107      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
    107108         !                      
    108          ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     109         ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm)                    ! thermosteric ssh 
    109110         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    110          CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     111         CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) )                       ! now in situ density using initial salinity 
    111112         ! 
    112113         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    113114         DO jk = 1, jpkm1 
    114             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     115            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
    115116         END DO 
    116117         IF( ln_linssh ) THEN 
    … …  
    118119               DO ji = 1, jpi 
    119120                  DO jj = 1, jpj 
    120                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     121                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
    121122                  END DO 
    122123               END DO 
    123124            ELSE 
    124                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     125               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
    125126            END IF 
    126127!!gm 
    … …  
    135136       
    136137         !                                         ! steric sea surface height 
    137          CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
     138         CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
    138139         zrhop(:,:,jpk) = 0._wp 
    139140         CALL iom_put( 'rhop', zrhop ) 
    … …  
    141142         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    142143         DO jk = 1, jpkm1 
    143             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     144            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
    144145         END DO 
    145146         IF( ln_linssh ) THEN 
    … …  
    147148               DO ji = 1,jpi 
    148149                  DO jj = 1,jpj 
    149                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     150                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
    150151                  END DO 
    151152               END DO 
    152153            ELSE 
    153                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     154               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
    154155            END IF 
    155156         END IF 
    … …  
    162163         !                                         ! ocean bottom pressure 
    163164         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    164          zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
     165         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) ) 
    165166         CALL iom_put( 'botpres', zbotpres ) 
    166167         ! 
    … …  
    174175            DO jj = 1, jpj 
    175176               DO ji = 1, jpi 
    176                   zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 
    177                   ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
    178                   zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
     177                  zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     178                  ztemp = ztemp + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
     179                  zsal  = zsal  + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
    179180               END DO 
    180181            END DO 
    … …  
    184185               DO ji = 1, jpi 
    185186                  DO jj = 1, jpj 
    186                      ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)  
    187                      zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)  
     187                     ztemp = ztemp + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_tem,Kmm)  
     188                     zsal  = zsal  + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_sal,Kmm)  
    188189                  END DO 
    189190               END DO 
    190191            ELSE 
    191                ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
    192                zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
     192               ztemp = ztemp + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
     193               zsal  = zsal  + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) ) 
    193194            END IF 
    194195         ENDIF 
    … …  
    219220                  DO ji = 1, jpi 
    220221                     IF( rn2(ji,jj,jk) > 0._wp ) THEN 
    221                         zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
    222                            &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
     222                        zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
     223                           &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 
    223224!!gm  this can be reduced to :  (depw-dept) / e3w   (NB idem dans bn2 !) 
    224 !                        zrw =   ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 
     225!                        zrw =   ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 
    225226!!gm end 
    226227                        ! 
    … …  
    229230                        ! 
    230231                        zpe(ji, jj) = zpe(ji, jj)            & 
    231                            &        -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
    232                            &                   - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     232                           &        -  grav * (  avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )  & 
     233                           &                   - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) 
    233234                     ENDIF 
    234235                  END DO 
    … …  
    239240               DO ji = 1, jpi 
    240241                  DO jj = 1, jpj 
    241                      zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
     242                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w(ji, jj, jk,Kmm) 
    242243                  END DO 
    243244               END DO 
    … …  
    261262 
    262263 
    263    SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva )  
     264   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )  
    264265      !!---------------------------------------------------------------------- 
    265266      !!                    ***  ROUTINE dia_ar5_htr *** 
    … …  
    270271      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    271272      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
    272       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pua   ! 3D input array of advection/diffusion 
    273       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     273      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
     274      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
    274275      ! 
    275276      INTEGER    ::  ji, jj, jk 
    … …  
    277278 
    278279     
    279       z2d(:,:) = pua(:,:,1)  
     280      z2d(:,:) = puflx(:,:,1)  
    280281      DO jk = 1, jpkm1 
    281282         DO jj = 2, jpjm1 
    282283            DO ji = fs_2, fs_jpim1   ! vector opt. 
    283                z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk)  
     284               z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
    284285            END DO 
    285286         END DO 
    … …  
    295296       ENDIF 
    296297       ! 
    297        z2d(:,:) = pva(:,:,1)  
     298       z2d(:,:) = pvflx(:,:,1)  
    298299       DO jk = 1, jpkm1 
    299300          DO jj = 2, jpjm1 
    300301             DO ji = fs_2, fs_jpim1   ! vector opt. 
    301                 z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk)  
     302                z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
    302303             END DO 
    303304          END DO 

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

    r10425 r10965  
    4545CONTAINS 
    4646 
    47    SUBROUTINE dia_cfl ( kt ) 
     47   SUBROUTINE dia_cfl ( kt, Kmm ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE dia_cfl  *** 
    … …  
    5353      !!---------------------------------------------------------------------- 
    5454      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     55      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    5556      ! 
    5657      INTEGER                ::   ji, jj, jk                            ! dummy loop indices 
    … …  
    7172         DO jj = 1, jpj 
    7273            DO ji = 1, fs_jpim1   ! vector opt. 
    73                zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    74                zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    75                zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
     74               zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
     75               zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
     76               zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * z2dt / e3w(ji,jj,jk,Kmm)   ! for k-direction 
    7677            END DO 
    7778         END DO          

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

    r10425 r10965  
    178178  
    179179  
    180   SUBROUTINE dia_dct( kt ) 
     180  SUBROUTINE dia_dct( kt, Kmm ) 
    181181     !!--------------------------------------------------------------------- 
    182182     !!               ***  ROUTINE diadct  ***   
    … …  
    195195     !!               Reinitialise all relevant arrays to zero  
    196196     !!--------------------------------------------------------------------- 
    197      INTEGER, INTENT(in) ::   kt 
     197     INTEGER, INTENT(in) ::   kt    ! ocean time step 
     198     INTEGER, INTENT(in) ::   Kmm   ! time level index 
    198199     ! 
    199200     INTEGER ::   jsec              ! loop on sections 
    … …  
    235236 
    236237           !Compute transport through section   
    237            CALL transport(secs(jsec),lldebug,jsec)  
     238           CALL transport(Kmm,secs(jsec),lldebug,jsec)  
    238239 
    239240        ENDDO 
    … …  
    249250           ! Sum over each class  
    250251           DO jsec=1,nb_sec  
    251               CALL dia_dct_sum(secs(jsec),jsec)  
     252              CALL dia_dct_sum(Kmm,secs(jsec),jsec)  
    252253           ENDDO  
    253254 
    … …  
    561562 
    562563 
    563    SUBROUTINE transport(sec,ld_debug,jsec) 
     564   SUBROUTINE transport(Kmm,sec,ld_debug,jsec) 
    564565     !!------------------------------------------------------------------------------------------- 
    565566     !!                     ***  ROUTINE transport  *** 
    … …  
    581582     !! 
    582583     !!------------------------------------------------------------------------------------------- 
     584     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    583585     TYPE(SECTION),INTENT(INOUT) :: sec 
    584586     LOGICAL      ,INTENT(IN)    :: ld_debug 
    … …  
    676678            SELECT CASE( sec%direction(jseg) ) 
    677679               CASE(0,1)  
    678                   ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    679                   zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    680                   zrhop = interp(k%I,k%J,jk,'V',rhop)  
    681                   zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
    682                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)  
     680                  ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     681                  zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     682                  zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     683                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
     684                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm)    ) * vmask(k%I,k%J,1)  
    683685               CASE(2,3)  
    684                   ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    685                   zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    686                   zrhop = interp(k%I,k%J,jk,'U',rhop)  
    687                   zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    688                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     686                  ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     687                  zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     688                  zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     689                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     690                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    689691               END SELECT  
    690692               ! 
    691                zdep= gdept_n(k%I,k%J,jk)  
     693               zdep= gdept(k%I,k%J,jk,Kmm)  
    692694   
    693695               SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction  
    694696               CASE(0,1)    
    695697                  zumid=0._wp 
    696                   zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk)  
     698                  zvmid=isgnv*vv(k%I,k%J,jk,Kmm)*vmask(k%I,k%J,jk)  
    697699               CASE(2,3)  
    698                   zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk)  
     700                  zumid=isgnu*uu(k%I,k%J,jk,Kmm)*umask(k%I,k%J,jk)  
    699701                  zvmid=0._wp 
    700702               END SELECT  
    … …  
    702704               !zTnorm=transport through one cell;  
    703705               !velocity* cell's length * cell's thickness  
    704                zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     &  
    705                   &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk)  
     706               zTnorm = zumid*e2u(k%I,k%J) * e3u(k%I,k%J,jk,Kmm)     &  
     707                  &   + zvmid*e1v(k%I,k%J) * e3v(k%I,k%J,jk,Kmm)  
    706708 
    707709!!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!! 
    … …  
    768770 
    769771 
    770   SUBROUTINE dia_dct_sum(sec,jsec)  
     772  SUBROUTINE dia_dct_sum(Kmm,sec,jsec)  
    771773     !!-------------------------------------------------------------  
    772774     !! Purpose: Average the transport over nn_dctwri time steps   
    … …  
    787789     !!  
    788790     !!-------------------------------------------------------------  
     791     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    789792     TYPE(SECTION),INTENT(INOUT) :: sec  
    790793     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section  
    … …  
    848851              SELECT CASE( sec%direction(jseg) )  
    849852              CASE(0,1)  
    850                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    851                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    852                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    853                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     853                 ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     854                 zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     855                 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     856                 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
    854857 
    855858              CASE(2,3)  
    856                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    857                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    858                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    859                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    860                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     859                 ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     860                 zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     861                 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     862                 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     863                 zsshn =  0.5*( ssh(k%I,k%J,Kmm)    + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    861864              END SELECT  
    862865  
    863               zdep= gdept_n(k%I,k%J,jk)  
     866              zdep= gdept(k%I,k%J,jk,Kmm)  
    864867   
    865868              !-------------------------------  
    … …  
    11041107 
    11051108 
    1106    FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     1109   FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab) 
    11071110  !!---------------------------------------------------------------------- 
    11081111  !! 
    … …  
    11651168  !!---------------------------------------------------------------------- 
    11661169  !*arguments 
     1170  INTEGER, INTENT(IN)                          :: Kmm          ! time level index 
    11671171  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point 
    11681172  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V) 
    … …  
    11991203  IF( ln_sco )THEN   ! s-coordinate case 
    12001204 
    1201      zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp  
    1202      zdep1 = gdept_n(ii1,ij1,kk) - zdepu 
    1203      zdep2 = gdept_n(ii2,ij2,kk) - zdepu 
     1205     zdepu = ( gdept(ii1,ij1,kk,Kmm) +  gdept(ii2,ij2,kk,Kmm) ) * 0.5_wp  
     1206     zdep1 = gdept(ii1,ij1,kk,Kmm) - zdepu 
     1207     zdep2 = gdept(ii2,ij2,kk,Kmm) - zdepu 
    12041208 
    12051209     ! weights 
    … …  
    12131217  ELSE       ! full step or partial step case  
    12141218 
    1215      ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)  
    1216      zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 
    1217      zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 
     1219     ze3t  = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm)  
     1220     zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm) 
     1221     zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm) 
    12181222 
    12191223     IF(kk .NE. 1)THEN 
    … …  
    12531257   END SUBROUTINE dia_dct_init 
    12541258 
    1255    SUBROUTINE dia_dct( kt )         ! Dummy routine 
     1259   SUBROUTINE dia_dct( kt, Kmm )         ! Dummy routine 
    12561260      IMPLICIT NONE 
    12571261      INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
     1262      INTEGER, INTENT( in ) :: Kmm  ! ocean time level index 
    12581263      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
    12591264   END SUBROUTINE dia_dct 

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

    r10425 r10965  
    162162 
    163163 
    164    SUBROUTINE dia_harm ( kt ) 
     164   SUBROUTINE dia_harm ( kt, Kmm ) 
    165165      !!---------------------------------------------------------------------- 
    166166      !!                 ***  ROUTINE dia_harm  *** 
    … …  
    172172      !!-------------------------------------------------------------------- 
    173173      INTEGER, INTENT( IN ) :: kt 
     174      INTEGER, INTENT( IN ) :: Kmm     ! time level index 
    174175      ! 
    175176      INTEGER  :: ji, jj, jh, jc, nhc 
    … …  
    194195                  DO ji = 1,jpi 
    195196                     ! Elevation 
    196                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
    197                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
    198                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     197                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*ssh(ji,jj,Kmm)*ssmask (ji,jj)         
     198                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*uu_b(ji,jj,Kmm)*ssumask(ji,jj) 
     199                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vv_b(ji,jj,Kmm)*ssvmask(ji,jj) 
    199200                  END DO 
    200201               END DO 
    … …  
    521522   LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE. 
    522523CONTAINS 
    523    SUBROUTINE dia_harm ( kt )     ! Empty routine 
     524   SUBROUTINE dia_harm ( kt, Kmm )     ! Empty routine 
    524525      INTEGER, INTENT( IN ) :: kt   
     526      INTEGER, INTENT( IN ) :: Kmm   
    525527      WRITE(*,*) 'dia_harm: you should not have seen this print' 
    526528   END SUBROUTINE dia_harm 

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

    r10425 r10965  
    5858CONTAINS 
    5959 
    60    SUBROUTINE dia_hsb( kt ) 
     60   SUBROUTINE dia_hsb( kt, Kbb, Kmm ) 
    6161      !!--------------------------------------------------------------------------- 
    6262      !!                  ***  ROUTINE dia_hsb  *** 
    … …  
    6969      !! 
    7070      !!--------------------------------------------------------------------------- 
    71       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     71      INTEGER, INTENT(in) ::   kt         ! ocean time-step index 
     72      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    7273      ! 
    7374      INTEGER    ::   ji, jj, jk                  ! dummy loop indice 
    … …  
    8687      IF( ln_timing )   CALL timing_start('dia_hsb')       
    8788      ! 
    88       tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 
    89       tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 
     89      ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; 
     90      ts(:,:,:,2,Kmm) = ts(:,:,:,2,Kmm) * tmask(:,:,:) ; ts(:,:,:,2,Kbb) = ts(:,:,:,2,Kbb) * tmask(:,:,:) ; 
    9091      ! ------------------------- ! 
    9192      ! 1 - Trends due to forcing ! 
    … …  
    108109            DO ji=1,jpi 
    109110               DO jj=1,jpj 
    110                   z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 
    111                   z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 
     111                  z2d0(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb) 
     112                  z2d1(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb) 
    112113               END DO 
    113114            END DO 
    114115         ELSE 
    115             z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 
    116             z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 
     116            z2d0(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_tem,Kbb) 
     117            z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 
    117118         END IF 
    118119         z_wn_trd_t = - glob_sum( 'diahsb', z2d0 )  
    … …  
    135136 
    136137      !                    ! volume variation (calculated with ssh) 
    137       zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*sshn(:,:) - surf_ini(:,:)*ssh_ini(:,:) ) 
     138      zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) ) 
    138139 
    139140      !                    ! heat & salt content variation (associated with ssh) 
    … …  
    142143            DO ji = 1, jpi 
    143144               DO jj = 1, jpj 
    144                   z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )  
    145                   z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )  
     145                  z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )  
     146                  z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) )  
    146147               END DO 
    147148            END DO 
    148149         ELSE                          ! no under ice-shelf seas 
    149             z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )  
    150             z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
     150            z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) )  
     151            z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) )  
    151152         END IF 
    152153         z_ssh_hc = glob_sum_full( 'diahsb', z2d0 )  
    … …  
    155156      ! 
    156157      DO jk = 1, jpkm1           ! volume variation (calculated with scale factors) 
    157          zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk) 
     158         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk) 
    158159      END DO 
    159160      zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
    160161      DO jk = 1, jpkm1           ! heat content variation 
    161          zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_tem) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 
     162         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 
    162163      END DO 
    163164      zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
    164165      DO jk = 1, jpkm1           ! salt content variation 
    165          zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_sal) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 
     166         zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 
    166167      END DO 
    167168      zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
    … …  
    185186      ! ----------------------- ! 
    186187      DO jk = 1, jpkm1           ! total ocean volume (calculated with scale factors) 
    187          zwrk(:,:,jk) = surf(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     188         zwrk(:,:,jk) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    188189      END DO 
    189190      zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 
    … …  
    191192!!gm to be added ? 
    192193!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution 
    193 !        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * sshn(:,:) ) 
     194!        zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * ssh(:,:,Kmm) ) 
    194195!      ENDIF 
    195196!!gm end 
    … …  
    233234      ENDIF 
    234235      ! 
    235       IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' ) 
     236      IF( lrst_oce )   CALL dia_hsb_rst( kt, Kmm, 'WRITE' ) 
    236237      ! 
    237238      IF( ln_timing )   CALL timing_stop('dia_hsb') 
    … …  
    240241 
    241242 
    242    SUBROUTINE dia_hsb_rst( kt, cdrw ) 
     243   SUBROUTINE dia_hsb_rst( kt, Kmm, cdrw ) 
    243244      !!--------------------------------------------------------------------- 
    244245      !!                   ***  ROUTINE dia_hsb_rst  *** 
    … …  
    249250      !!---------------------------------------------------------------------- 
    250251      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     252      INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index 
    251253      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    252254      ! 
    … …  
    281283            IF(lwp) WRITE(numout,*) 
    282284            surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
    283             ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
     285            ssh_ini(:,:) = ssh(:,:,Kmm)                          ! initial ssh 
    284286            DO jk = 1, jpk 
    285287              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    286                e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
    287                hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
    288                sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
     288               e3t_ini   (:,:,jk) = e3t(:,:,jk,Kmm)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     289               hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial heat content 
     290               sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)  ! initial salt content 
    289291            END DO 
    290292            frc_v = 0._wp                                           ! volume       trend due to forcing 
    … …  
    295297                  DO ji = 1, jpi 
    296298                     DO jj = 1, jpj 
    297                         ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
    298                         ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
     299                        ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm)   ! initial heat content in ssh 
     300                        ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm)   ! initial salt content in ssh 
    299301                     END DO 
    300302                   END DO 
    301303                ELSE 
    302                   ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
    303                   ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     304                  ssh_hc_loc_ini(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm)   ! initial heat content in ssh 
     305                  ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm)   ! initial salt content in ssh 
    304306               END IF 
    305307               frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
    … …  
    338340 
    339341 
    340    SUBROUTINE dia_hsb_init 
     342   SUBROUTINE dia_hsb_init( Kmm ) 
    341343      !!--------------------------------------------------------------------------- 
    342344      !!                  ***  ROUTINE dia_hsb  *** 
    … …  
    350352      !!             - Compute coefficients for conversion 
    351353      !!--------------------------------------------------------------------------- 
     354      INTEGER, INTENT(in) :: Kmm ! time level index 
     355      ! 
    352356      INTEGER ::   ierror, ios   ! local integer 
    353357      !! 
    … …  
    417421      ! 4 - initial conservation variables ! 
    418422      ! ---------------------------------- ! 
    419       CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files 
     423      CALL dia_hsb_rst( nit000, Kmm, 'READ' )  !* read or initialize all required files 
    420424      ! 
    421425   END SUBROUTINE dia_hsb_init 

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

    r10425 r10965  
    6060 
    6161 
    62    SUBROUTINE dia_hth( kt ) 
     62   SUBROUTINE dia_hth( kt, Kmm ) 
    6363      !!--------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE dia_hth  *** 
    … …  
    8181      !!------------------------------------------------------------------- 
    8282      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     83      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index 
    8384      !! 
    8485      INTEGER                          ::   ji, jj, jk            ! dummy loop arguments 
    … …  
    139140      DO jj = 1, jpj 
    140141         DO ji = 1, jpi 
    141             zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1)  
     142            zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)  
    142143            hth     (ji,jj) = zztmp 
    143144            zabs2   (ji,jj) = zztmp 
    … …  
    150151         DO jj = 1, jpj 
    151152            DO ji = 1, jpi 
    152                zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1)  
     153               zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)  
    153154               zrho0_3(ji,jj) = zztmp 
    154155               zrho0_1(ji,jj) = zztmp 
    … …  
    162163         DO ji = 1, jpi 
    163164            IF( tmask(ji,jj,nla10) == 1. ) THEN 
    164                zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)                             & 
    165                   &                                              - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   & 
    166                   &                                              - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal) 
    167                zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)                             & 
    168                   &                                              - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem) 
    169                zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal) 
    170                zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem) 
     165               zu  =  1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80   * ts(ji,jj,nla10,jp_sal,Kmm)                             & 
     166                  &                                              - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm)   & 
     167                  &                                              - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 
     168               zv  =  5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00   * ts(ji,jj,nla10,jp_sal,Kmm)                             & 
     169                  &                                              - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 
     170               zut =    11.25 -  0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01   * ts(ji,jj,nla10,jp_sal,Kmm) 
     171               zvt =    38.00 -  0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 
    171172               zw  = (zu + 0.698*zv) * (zu + 0.698*zv) 
    172173               zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 
    … …  
    187188            DO ji = 1, jpi 
    188189               ! 
    189                zzdep = gdepw_n(ji,jj,jk) 
    190                zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
     190               zzdep = gdepw(ji,jj,jk,Kmm) 
     191               zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
    191192               zzdep = zzdep * tmask(ji,jj,1) 
    192193 
    … …  
    223224            DO ji = 1, jpi 
    224225               ! 
    225                zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1) 
     226               zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 
    226227               ! 
    227                zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m) 
     228               zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm)  ! - delta T(10m) 
    228229               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2 
    229230               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2 
    … …  
    257258         DO jj = 1, jpj 
    258259            DO ji = 1, jpi 
    259                zztmp = tsn(ji,jj,jk,jp_tem) 
     260               zztmp = ts(ji,jj,jk,jp_tem,Kmm) 
    260261               IF( zztmp >= 20. )   ik20(ji,jj) = jk 
    261262               IF( zztmp >= 28. )   ik28(ji,jj) = jk 
    … …  
    270271         DO ji = 1, jpi 
    271272            ! 
    272             zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom 
     273            zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)       ! depth of the oean bottom 
    273274            ! 
    274275            iid = ik20(ji,jj) 
    275276            IF( iid /= 1 ) THEN  
    276                zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation 
    277                   &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   & 
    278                   &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   & 
    279                   &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
     277               zztmp =      gdept(ji,jj,iid  ,Kmm)   &                     ! linear interpolation 
     278                  &  + (    gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm)                       )   & 
     279                  &  * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm)                       )   & 
     280                  &  / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 
    280281               hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth 
    281282            ELSE  
    … …  
    285286            iid = ik28(ji,jj) 
    286287            IF( iid /= 1 ) THEN  
    287                zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation 
    288                   &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   & 
    289                   &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   & 
    290                   &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
     288               zztmp =      gdept(ji,jj,iid  ,Kmm)   &                     ! linear interpolation 
     289                  &  + (    gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm)                       )   & 
     290                  &  * ( 28.*tmask(ji,jj,iid+1) -    ts(ji,jj,iid,jp_tem,Kmm)                       )   & 
     291                  &  / (  ts(ji,jj,iid+1,jp_tem,Kmm) -    ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 
    291292               hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth 
    292293            ELSE  
    … …  
    311312      END DO 
    312313      ! surface boundary condition 
    313       IF( ln_linssh ) THEN   ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
     314      IF( ln_linssh ) THEN   ;   zthick(:,:) = ssh(:,:,Kmm)   ;   htc3(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) * tmask(:,:,1)   
    314315      ELSE                   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    315316      ENDIF 
    316317      ! integration down to ilevel 
    317318      DO jk = 1, ilevel 
    318          zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk) 
    319          htc3  (:,:) = htc3  (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 
     319         zthick(:,:) = zthick(:,:) + e3t(:,:,jk,Kmm) 
     320         htc3  (:,:) = htc3  (:,:) + e3t(:,:,jk,Kmm) * ts(:,:,jk,jp_tem,Kmm) * tmask(:,:,jk) 
    320321      END DO 
    321322      ! deepest layer 
    … …  
    323324      DO jj = 1, jpj 
    324325         DO ji = 1, jpi 
    325             htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem)                  & 
    326                &                      * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
     326            htc3(ji,jj) = htc3(ji,jj) + ts(ji,jj,ilevel+1,jp_tem,Kmm)                  & 
     327               &                      * MIN( e3t(ji,jj,ilevel+1,Kmm), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
    327328         END DO 
    328329      END DO 
    … …  
    342343   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .FALSE.  !: thermocline-20d depths flag 
    343344CONTAINS 
    344    SUBROUTINE dia_hth( kt )         ! Empty routine 
     345   SUBROUTINE dia_hth( kt, Kmm )         ! Empty routine 
    345346      IMPLICIT NONE 
    346347      INTEGER, INTENT( in ) :: kt 
     348      INTEGER, INTENT( in ) :: Kmm 
    347349      WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 
    348350   END SUBROUTINE dia_hth 

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

    r10425 r10965  
    7171CONTAINS 
    7272 
    73    SUBROUTINE dia_ptr( pvtr ) 
     73   SUBROUTINE dia_ptr( Kmm, pvtr ) 
    7474      !!---------------------------------------------------------------------- 
    7575      !!                  ***  ROUTINE dia_ptr  *** 
    7676      !!---------------------------------------------------------------------- 
     77      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index 
    7778      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
    7879      ! 
    … …  
    9091      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
    9192      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvv   ! 3D workspace 
    9394 
    9495 
    … …  
    126127            zmask(:,:,:) = 0._wp 
    127128            zts(:,:,:,:) = 0._wp 
    128             zvn(:,:,:) = 0._wp 
     129            zvv(:,:,:) = 0._wp 
    129130            DO jk = 1, jpkm1 
    130131               DO jj = 1, jpjm1 
    131132                  DO ji = 1, jpi 
    132                      zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 
     133                     zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    133134                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
    134                      zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    135                      zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    136                      zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
     135                     zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     136                     zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     137                     zvv(ji,jj,jk)        = vv(ji,jj,jk,Kmm)         * zvfc 
    137138                  ENDDO 
    138139               ENDDO 
    … …  
    147148             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
    148149             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
    149              v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
     150             v_msf(:,:,1) = ptr_sjk( zvv(:,:,:) ) 
    150151 
    151152             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
    … …  
    173174                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    174175                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    175                     v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
     176                    v_msf(:,:,jn) = ptr_sjk( zvv(:,:,:), btmsk(:,:,jn) )  
    176177                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
    177178                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
    … …  
    198199             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
    199200             
    200             vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
     201            vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,1)) 
    201202            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
    202203            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
    … …  
    220221                    r1_sjk(:,1,jn) = 0._wp 
    221222                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
    222                     vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
     223                    vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,jn)) 
    223224                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
    224225                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
    … …  
    247248               DO jj = 1, jpj 
    248249                  DO ji = 1, jpi 
    249                      zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk) 
     250                     zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    250251                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    251                      zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
    252                      zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 
     252                     zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
     253                     zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
    253254                  END DO 
    254255               END DO 
    … …  
    459460 
    460461 
    461    SUBROUTINE dia_ptr_hst( ktra, cptr, pva )  
     462   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx )  
    462463      !!---------------------------------------------------------------------- 
    463464      !!                    ***  ROUTINE dia_ptr_hst *** 
    … …  
    468469      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    469470      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
    470       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     471      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx   ! 3D input array of advection/diffusion 
    471472      INTEGER                                        :: jn    ! 
    472473 
    473474      IF( cptr == 'adv' ) THEN 
    474          IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
    475          IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     475         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pvflx ) 
     476         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pvflx ) 
    476477      ENDIF 
    477478      IF( cptr == 'ldf' ) THEN 
    478          IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
    479          IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     479         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pvflx ) 
     480         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pvflx ) 
    480481      ENDIF 
    481482      IF( cptr == 'eiv' ) THEN 
    482          IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
    483          IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     483         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pvflx ) 
     484         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pvflx ) 
    484485      ENDIF 
    485486      ! 
    … …  
    489490             IF( ktra == jp_tem ) THEN  
    490491                DO jn = 2, nptr 
    491                    htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     492                   htr_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    492493                END DO 
    493494             ENDIF 
    494495             IF( ktra == jp_sal ) THEN  
    495496                DO jn = 2, nptr 
    496                    str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     497                   str_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    497498                END DO 
    498499             ENDIF 
    … …  
    501502             IF( ktra == jp_tem ) THEN  
    502503                DO jn = 2, nptr 
    503                     htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     504                    htr_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    504505                 END DO 
    505506             ENDIF 
    506507             IF( ktra == jp_sal ) THEN  
    507508                DO jn = 2, nptr 
    508                    str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     509                   str_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    509510                END DO 
    510511             ENDIF 
    … …  
    513514             IF( ktra == jp_tem ) THEN  
    514515                DO jn = 2, nptr 
    515                     htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     516                    htr_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    516517                 END DO 
    517518             ENDIF 
    518519             IF( ktra == jp_sal ) THEN  
    519520                DO jn = 2, nptr 
    520                    str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     521                   str_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 
    521522                END DO 
    522523             ENDIF 
    … …  
    554555 
    555556 
    556    FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval ) 
     557   FUNCTION ptr_sj_3d( pvflx, pmsk )   RESULT ( p_fval ) 
    557558      !!---------------------------------------------------------------------- 
    558559      !!                    ***  ROUTINE ptr_sj_3d  *** 
    … …  
    560561      !! ** Purpose :   i-k sum computation of a j-flux array 
    561562      !! 
    562       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    563       !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    564       !! 
    565       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    566       !!---------------------------------------------------------------------- 
    567       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point 
     563      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i). 
     564      !!              pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     565      !! 
     566      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
     567      !!---------------------------------------------------------------------- 
     568      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pvflx   ! mask flux array at V-point 
    568569      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    569570      ! 
    … …  
    581582            DO jj = 2, jpjm1 
    582583               DO ji = fs_2, fs_jpim1   ! Vector opt. 
    583                   p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 
     584                  p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 
    584585               END DO 
    585586            END DO 
    … …  
    589590            DO jj = 2, jpjm1 
    590591               DO ji = fs_2, fs_jpim1   ! Vector opt. 
    591                   p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
     592                  p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj)  
    592593               END DO 
    593594            END DO 
    … …  
    601602 
    602603 
    603    FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval ) 
     604   FUNCTION ptr_sj_2d( pvflx, pmsk )   RESULT ( p_fval ) 
    604605      !!---------------------------------------------------------------------- 
    605606      !!                    ***  ROUTINE ptr_sj_2d  *** 
    606607      !! 
    607       !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
    608       !! 
    609       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    610       !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    611       !! 
    612       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    613       !!---------------------------------------------------------------------- 
    614       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point 
     608      !! ** Purpose :   "zonal" and vertical sum computation of a j-flux array 
     609      !! 
     610      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i). 
     611      !!      pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     612      !! 
     613      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
     614      !!---------------------------------------------------------------------- 
     615      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pvflx   ! mask flux array at V-point 
    615616      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    616617      ! 
    … …  
    627628         DO jj = 2, jpjm1 
    628629            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    629                p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 
     630               p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 
    630631            END DO 
    631632         END DO 
    … …  
    633634         DO jj = 2, jpjm1 
    634635            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    635                p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
     636               p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) 
    636637            END DO 
    637638         END DO 
    … …  
    644645 
    645646 
    646    FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval ) 
     647   FUNCTION ptr_sjk( pfld, pmsk )   RESULT ( p_fval ) 
    647648      !!---------------------------------------------------------------------- 
    648649      !!                    ***  ROUTINE ptr_sjk  *** 
    … …  
    650651      !! ** Purpose :   i-sum computation of an array 
    651652      !! 
    652       !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
    653       !! 
    654       !! ** Action  : - p_fval: i-mean poleward flux of pva 
     653      !! ** Method  : - i-sum of field using the interior 2D vmask (pmsk). 
     654      !! 
     655      !! ** Action  : - p_fval: i-sum of masked field 
    655656      !!---------------------------------------------------------------------- 
    656657      !! 
    657658      IMPLICIT none 
    658       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point 
     659      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pfld   ! input field to be summed 
    659660      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    660661      !! 
    … …  
    678679!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
    679680               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    680                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 
     681                  p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * pmsk(ji,jj) 
    681682               END DO 
    682683            END DO 
    … …  
    686687            DO jj = 2, jpjm1 
    687688               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    688                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 
     689                  p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * tmask_i(ji,jj) 
    689690               END DO 
    690691            END DO 

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

    r10499 r10965  
    9494 
    9595 
    96    SUBROUTINE dia_tmb 
     96   SUBROUTINE dia_tmb( Kmm ) 
    9797      !!---------------------------------------------------------------------- 
    9898      !!                 ***  ROUTINE dia_tmb  *** 
    … …  
    103103      !! 
    104104      !!-------------------------------------------------------------------- 
     105      INTEGER, INTENT(in) :: Kmm     ! time level index 
     106      ! 
    105107      REAL(wp) ::   zmdi =1.e+20     ! land value 
    106108      REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb    ! workspace  
    107109      !!-------------------------------------------------------------------- 
    108110      ! 
    109       CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb ) 
     111      CALL dia_calctmb( ts(:,:,:,jp_tem,Kmm), zwtmb ) 
    110112      !ssh already output but here we output it masked 
    111113      IF( ll_wd ) THEN 
    112          CALL iom_put( "sshnmasked", (sshn(:,:)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 
     114         CALL iom_put( "sshnmasked", (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 
    113115      ELSE 
    114          CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 
     116         CALL iom_put( "sshnmasked", ssh(:,:,Kmm)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 
    115117      ENDIF 
    116118 
    … …  
    119121      CALL iom_put( "bot_temp"  , zwtmb(:,:,3) )    ! tmb Temperature 
    120122      ! 
    121       CALL dia_calctmb( tsn(:,:,:,jp_sal), zwtmb ) 
     123      CALL dia_calctmb( ts(:,:,:,jp_sal,Kmm), zwtmb ) 
    122124      CALL iom_put( "top_sal"   , zwtmb(:,:,1) )    ! tmb Salinity  
    123125      CALL iom_put( "mid_sal"   , zwtmb(:,:,2) )    ! tmb Salinity 
    124126      CALL iom_put( "bot_sal"   , zwtmb(:,:,3) )    ! tmb Salinity 
    125127      ! 
    126       CALL dia_calctmb( un(:,:,:), zwtmb ) 
     128      CALL dia_calctmb( uu(:,:,:,Kmm), zwtmb ) 
    127129      CALL iom_put( "top_u"     , zwtmb(:,:,1) )    ! tmb  U Velocity 
    128130      CALL iom_put( "mid_u"     , zwtmb(:,:,2) )    ! tmb  U Velocity 
    129131      CALL iom_put( "bot_u"     , zwtmb(:,:,3) )    ! tmb  U Velocity 
    130132      ! 
    131       CALL dia_calctmb( vn(:,:,:), zwtmb ) 
     133      CALL dia_calctmb( vv(:,:,:,Kmm), zwtmb ) 
    132134      CALL iom_put( "top_v"     , zwtmb(:,:,1) )    ! tmb  V Velocity 
    133135      CALL iom_put( "mid_v"     , zwtmb(:,:,2) )    ! tmb  V Velocity 

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

    r10425 r10965  
    9797 
    9898    
    99    SUBROUTINE dia_wri( kt ) 
     99   SUBROUTINE dia_wri( kt, Kmm ) 
    100100      !!--------------------------------------------------------------------- 
    101101      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    107107      !!---------------------------------------------------------------------- 
    108108      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     109      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index 
    109110      !! 
    110111      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    … …  
    120121      ! Output the initial state and forcings 
    121122      IF( ninist == 1 ) THEN                        
    122          CALL dia_wri_state( 'output.init' ) 
     123         CALL dia_wri_state( Kmm, 'output.init' ) 
    123124         ninist = 0 
    124125      ENDIF 
    … …  
    129130      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
    130131      ! 
    131       CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
    132       CALL iom_put( "e3u" , e3u_n(:,:,:) ) 
    133       CALL iom_put( "e3v" , e3v_n(:,:,:) ) 
    134       CALL iom_put( "e3w" , e3w_n(:,:,:) ) 
     132      CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 
     133      CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 
     134      CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 
     135      CALL iom_put( "e3w" , e3w(:,:,:,Kmm) ) 
    135136      IF( iom_use("e3tdef") )   & 
    136          CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
     137         CALL iom_put( "e3tdef"  , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
    137138 
    138139      IF( ll_wd ) THEN 
    139140         CALL iom_put( "ssh" , (sshn+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
    140141      ELSE 
    141          CALL iom_put( "ssh" , sshn )              ! sea surface height 
     142         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 
    142143      ENDIF 
    143144 
    144145      IF( iom_use("wetdep") )   &                  ! wet depth 
    145          CALL iom_put( "wetdep" , ht_0(:,:) + sshn(:,:) ) 
     146         CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 
    146147       
    147       CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
    148       CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
     148      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature 
     149      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature 
    149150      IF ( iom_use("sbt") ) THEN 
    150151         DO jj = 1, jpj 
    151152            DO ji = 1, jpi 
    152153               ikbot = mbkt(ji,jj) 
    153                z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 
     154               z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 
    154155            END DO 
    155156         END DO 
    … …  
    157158      ENDIF 
    158159       
    159       CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity 
    160       CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
     160      CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) )    ! 3D salinity 
     161      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity 
    161162      IF ( iom_use("sbs") ) THEN 
    162163         DO jj = 1, jpj 
    163164            DO ji = 1, jpi 
    164165               ikbot = mbkt(ji,jj) 
    165                z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 
     166               z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 
    166167            END DO 
    167168         END DO 
    … …  
    174175         DO jj = 2, jpjm1 
    175176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * un(ji  ,jj,mbku(ji  ,jj))  )**2   & 
    177                   &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj))  )**2   & 
    178                   &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vn(ji,jj  ,mbkv(ji,jj  ))  )**2   & 
    179                   &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1))  )**2 
     177               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   & 
     178                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   & 
     179                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   & 
     180                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2 
    180181               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)  
    181182               ! 
    … …  
    186187      ENDIF 
    187188          
    188       CALL iom_put( "uoce", un(:,:,:) )            ! 3D i-current 
    189       CALL iom_put(  "ssu", un(:,:,1) )            ! surface i-current 
     189      CALL iom_put( "uoce", uu(:,:,:,Kmm) )            ! 3D i-current 
     190      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current 
    190191      IF ( iom_use("sbu") ) THEN 
    191192         DO jj = 1, jpj 
    192193            DO ji = 1, jpi 
    193194               ikbot = mbku(ji,jj) 
    194                z2d(ji,jj) = un(ji,jj,ikbot) 
     195               z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 
    195196            END DO 
    196197         END DO 
    … …  
    198199      ENDIF 
    199200       
    200       CALL iom_put( "voce", vn(:,:,:) )            ! 3D j-current 
    201       CALL iom_put(  "ssv", vn(:,:,1) )            ! surface j-current 
     201      CALL iom_put( "voce", vv(:,:,:,Kmm) )            ! 3D j-current 
     202      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current 
    202203      IF ( iom_use("sbv") ) THEN 
    203204         DO jj = 1, jpj 
    204205            DO ji = 1, jpi 
    205206               ikbot = mbkv(ji,jj) 
    206                z2d(ji,jj) = vn(ji,jj,ikbot) 
     207               z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 
    207208            END DO 
    208209         END DO 
    … …  
    210211      ENDIF 
    211212 
    212       CALL iom_put( "woce", wn )                   ! vertical velocity 
     213      CALL iom_put( "woce", ww )                   ! vertical velocity 
    213214      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    214215         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    215216         z2d(:,:) = rau0 * e1e2t(:,:) 
    216217         DO jk = 1, jpk 
    217             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     218            z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:) 
    218219         END DO 
    219220         CALL iom_put( "w_masstr" , z3d )   
    … …  
    231232         DO jj = 2, jpjm1                                    ! sst gradient 
    232233            DO ji = fs_2, fs_jpim1   ! vector opt. 
    233                zztmp  = tsn(ji,jj,1,jp_tem) 
    234                zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj) 
    235                zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1) 
     234               zztmp  = ts(ji,jj,1,jp_tem,Kmm) 
     235               zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 
     236               zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 
    236237               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    237238                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    … …  
    250251            DO jj = 1, jpj 
    251252               DO ji = 1, jpi 
    252                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     253                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 
    253254               END DO 
    254255            END DO 
    … …  
    262263            DO jj = 1, jpj 
    263264               DO ji = 1, jpi 
    264                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     265                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
    265266               END DO 
    266267            END DO 
    … …  
    274275            DO jj = 2, jpjm1 
    275276               DO ji = fs_2, fs_jpim1   ! vector opt. 
    276                   zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    277                   z3d(ji,jj,jk) = zztmp * (  un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   & 
    278                      &                     + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   & 
    279                      &                     + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   & 
    280                      &                     + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   ) 
     277                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     278                  z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   & 
     279                     &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   & 
     280                     &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   & 
     281                     &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
    281282               END DO 
    282283            END DO 
    … …  
    286287      ENDIF 
    287288      ! 
    288       CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
     289      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence 
    289290      ! 
    290291      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    … …  
    292293         z2d(:,:) = 0.e0 
    293294         DO jk = 1, jpkm1 
    294             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     295            z3d(:,:,jk) = rau0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    295296            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    296297         END DO 
    … …  
    304305            DO jj = 2, jpjm1 
    305306               DO ji = fs_2, fs_jpim1   ! vector opt. 
    306                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     307                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
    307308               END DO 
    308309            END DO 
    … …  
    317318            DO jj = 2, jpjm1 
    318319               DO ji = fs_2, fs_jpim1   ! vector opt. 
    319                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     320                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
    320321               END DO 
    321322            END DO 
    … …  
    329330         z3d(:,:,jpk) = 0.e0 
    330331         DO jk = 1, jpkm1 
    331             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     332            z3d(:,:,jk) = rau0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    332333         END DO 
    333334         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction 
    … …  
    339340            DO jj = 2, jpjm1 
    340341               DO ji = fs_2, fs_jpim1   ! vector opt. 
    341                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     342                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
    342343               END DO 
    343344            END DO 
    … …  
    352353            DO jj = 2, jpjm1 
    353354               DO ji = fs_2, fs_jpim1   ! vector opt. 
    354                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     355                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
    355356               END DO 
    356357            END DO 
    … …  
    365366            DO jj = 2, jpjm1 
    366367               DO ji = fs_2, fs_jpim1   ! vector opt. 
    367                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
     368                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
    368369               END DO 
    369370            END DO 
    … …  
    377378            DO jj = 2, jpjm1 
    378379               DO ji = fs_2, fs_jpim1   ! vector opt. 
    379                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
     380                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    380381               END DO 
    381382            END DO 
    … …  
    388389      ! 
    389390 
    390       IF (ln_diatmb)   CALL dia_tmb                   ! tmb values  
     391      IF (ln_diatmb)   CALL dia_tmb( Kmm )            ! tmb values  
    391392           
    392       IF (ln_dia25h)   CALL dia_25h( kt )             ! 25h averaging 
     393      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging 
    393394 
    394395      IF( ln_timing )   CALL timing_stop('dia_wri') 
    … …  
    416417 
    417418    
    418    SUBROUTINE dia_wri( kt ) 
     419   SUBROUTINE dia_wri( kt, Kmm ) 
    419420      !!--------------------------------------------------------------------- 
    420421      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    429430      !!---------------------------------------------------------------------- 
    430431      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     432      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    431433      ! 
    432434      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    … …  
    446448      ! 
    447449      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    448          CALL dia_wri_state( 'output.init' ) 
     450         CALL dia_wri_state( Kmm, 'output.init' ) 
    449451         ninist = 0 
    450452      ENDIF 
    … …  
    583585            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    584586         IF(  .NOT.ln_linssh  ) THEN 
    585             CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n 
     587            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t(:,:,:,Kmm) 
    586588            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    587             CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n 
     589            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t(:,:,:,Kmm) 
    588590            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    589             CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n 
     591            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t(:,:,:,Kmm) 
    590592            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    591593         ENDIF 
    … …  
    604606            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    605607         IF(  ln_linssh  ) THEN 
    606             CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem) 
     608            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * ts(:,:,1,jp_tem,Kmm) 
    607609            &                                                                  , "KgC/m2/s",  &  ! sosst_cd 
    608610            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    609             CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * tsn(:,:,1,jp_sal) 
     611            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * ts(:,:,1,jp_sal,Kmm) 
    610612            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd 
    611613            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    692694 
    693695         !                                                                                      !!! nid_U : 3D 
    694          CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
     696         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! uu(:,:,:,Kmm) 
    695697            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    696698         IF( ln_wave .AND. ln_sdw) THEN 
    … …  
    705707 
    706708         !                                                                                      !!! nid_V : 3D 
    707          CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
     709         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vv(:,:,:,Kmm) 
    708710            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    709711         IF( ln_wave .AND. ln_sdw) THEN 
    … …  
    718720 
    719721         !                                                                                      !!! nid_W : 3D 
    720          CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
     722         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! ww 
    721723            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    722724         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    … …  
    756758 
    757759      IF( .NOT.ln_linssh ) THEN 
    758          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    759          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content 
    760          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
    761          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
     760         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! heat content 
     761         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! salt content 
     762         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface heat content 
     763         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity content 
    762764      ELSE 
    763          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature 
    764          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity 
    765          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature 
    766          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity 
     765         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature 
     766         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T  )   ! salinity 
     767         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT )   ! sea surface temperature 
     768         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity 
    767769      ENDIF 
    768770      IF( .NOT.ln_linssh ) THEN 
    769          zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    770          CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    771          CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
     771         zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
     772         CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm) , ndim_T , ndex_T  )   ! level thickness 
     773         CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T  )   ! t-point depth 
    772774         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation 
    773775      ENDIF 
    774       CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
     776      CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm)          , ndim_hT, ndex_hT )   ! sea surface height 
    775777      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux 
    776778      CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs 
    … …  
    779781                                                                                  ! in linear free surface case) 
    780782      IF( ln_linssh ) THEN 
    781          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
     783         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm) 
    782784         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    783          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
     785         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm) 
    784786         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    785787      ENDIF 
    … …  
    817819         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    818820         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    819          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     821         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
    820822         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    821823      ENDIF 
    … …  
    823825         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    824826         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    825          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     827         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
    826828         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    827829      ENDIF 
    … …  
    836838#endif 
    837839 
    838       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
     840      CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm)            , ndim_U , ndex_U )    ! i-current 
    839841      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    840842 
    841       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
     843      CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm)            , ndim_V , ndex_V  )   ! j-current 
    842844      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    843845 
    844       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
     846      CALL histwrite( nid_W, "vovecrtz", it, ww             , ndim_T, ndex_T )    ! vert. current 
    845847      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    846848      CALL histwrite( nid_W, "votkeavm", it, avm            , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
    … …  
    869871#endif 
    870872 
    871    SUBROUTINE dia_wri_state( cdfile_name ) 
     873   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    872874      !!--------------------------------------------------------------------- 
    873875      !!                 ***  ROUTINE dia_wri_state  *** 
    … …  
    882884      !!      File 'output.abort.nc' is created in case of abnormal job end 
    883885      !!---------------------------------------------------------------------- 
     886      INTEGER           , INTENT( in ) ::   Kmm              ! time level index 
    884887      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    885888      !! 
    … …  
    898901#endif 
    899902 
    900       CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
    901       CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
    902       CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
    903       CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    904       CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
    905       CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
     903      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
     904      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
     905      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height 
     906      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity 
     907      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity 
     908      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                )    ! now k-velocity 
    906909      IF( ALLOCATED(ahtu) ) THEN 
    907910         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
    … …  
    919922      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
    920923      IF(  .NOT.ln_linssh  ) THEN              
    921          CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
    922          CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     924         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth  
     925         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)          )    !  T-cell thickness   
    923926      END IF 
    924927      IF( ln_wave .AND. ln_sdw ) THEN 

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

    r10954 r10965  
    136136      ! 
    137137!!gm ??? 
    138       IF( ln_diaptr )   CALL dia_ptr( zvv )                                    ! diagnose the effective MSF  
     138      IF( ln_diaptr )   CALL dia_ptr( Kmm, zvv )                               ! diagnose the effective MSF  
    139139!!gm ??? 
    140140      ! 

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

    r10954 r10965  
    489489                           CALL dia_ptr_init    ! Poleward TRansports initialization 
    490490      IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports 
    491                            CALL dia_hsb_init    ! heat content, salt content and volume budgets 
     491                           CALL dia_hsb_init( Nnn )    ! heat content, salt content and volume budgets 
    492492                           CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends 
    493493                           CALL dia_obs_init( Nnn )    ! Initialize observational data 
    494494                           CALL dia_tmb_init    ! TMB outputs 
    495                            CALL dia_25h_init    ! 25h mean  outputs 
     495                           CALL dia_25h_init( Nbb )    ! 25h mean  outputs 
    496496      IF( ln_diaobs    )   CALL dia_obs( nit000-1, Nnn )   ! Observation operator for restart 
    497497 

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

    r10957 r10965  
    219219      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    220220      IF( lk_floats  )   CALL flo_stp ( kstp )        ! drifting Floats 
    221       IF( ln_diacfl  )   CALL dia_cfl ( kstp )        ! Courant number diagnostics 
    222       IF( lk_diahth  )   CALL dia_hth ( kstp )        ! Thermocline depth (20 degres isotherm depth) 
    223       IF( lk_diadct  )   CALL dia_dct ( kstp )        ! Transports 
    224                          CALL dia_ar5 ( kstp )        ! ar5 diag 
    225       IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    226                          CALL dia_wri ( kstp )        ! ocean model: outputs 
     221      IF( ln_diacfl  )   CALL dia_cfl ( kstp, Nnn )   ! Courant number diagnostics 
     222      IF( lk_diahth  )   CALL dia_hth ( kstp, Nnn )   ! Thermocline depth (20 degres isotherm depth) 
     223      IF( lk_diadct  )   CALL dia_dct ( kstp, Nnn )   ! Transports 
     224                         CALL dia_ar5 ( kstp, Nnn )   ! ar5 diag 
     225      IF( lk_diaharm )   CALL dia_harm( kstp, Nnn )   ! Tidal harmonic analysis 
     226                         CALL dia_wri ( kstp, Nnn )   ! ocean model: outputs 
    227227      ! 
    228228      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output 
    … …  
    259259 
    260260!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    261       IF( ln_diaptr  )   CALL dia_ptr                 ! Poleward adv/ldf TRansports diagnostics 
     261      IF( ln_diaptr  )   CALL dia_ptr( Nnn )                 ! Poleward adv/ldf TRansports diagnostics 
    262262!!gm 
    263263                         CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vert. mixing & after tracer   ==> after 
    … …  
    286286      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
    287287      ! 
    288       IF( ln_diahsb  )   CALL dia_hsb       ( kstp )  ! - ML - global conservation diagnostics 
     288      IF( ln_diahsb  )   CALL dia_hsb       ( kstp, Nbb, Nnn )  ! - ML - global conservation diagnostics 
    289289 
    290290!!gm : This does not only concern the dynamics ==>>> add a new title 
    … …  
    309309      ! Control 
    310310      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    311                          CALL stp_ctl      ( kstp, indic ) 
     311                         CALL stp_ctl      ( kstp, Nnn, indic ) 
    312312                          
    313313      IF( kstp == nit000 ) THEN                          ! 1st time step only 

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

    r10570 r10965  
    4242CONTAINS 
    4343 
    44    SUBROUTINE stp_ctl( kt, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm, kindic ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    6060      !!---------------------------------------------------------------------- 
    6161      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     62      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
    6263      INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    6364      !! 
    … …  
    111112      !                                   !==  test of extrema  ==! 
    112113      IF( ll_wd ) THEN 
    113          zmax(1) = MAXVAL(  ABS( sshn(:,:) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
     114         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
    114115      ELSE 
    115          zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                               ! ssh max 
     116         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max 
    116117      ENDIF 
    117       zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only) 
    118       zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    119       zmax(4) = MAXVAL(  tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
    120       zmax(5) = MAXVAL( -tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
    121       zmax(6) = MAXVAL(  tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
     118      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
     119      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
     120      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
     121      zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
     122      zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
    122123      zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
    123124      IF( ln_zad_Aimp ) THEN 
    … …  
    155156         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    156157         IF( lk_mpp .AND. ln_ctl ) THEN 
    157             CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
    158             CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  ) 
    159             CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 
    160             CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 
     158            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
     159            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
     160            CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 
     161            CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 
    161162         ELSE 
    162             ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    163             iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    164             is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    165             is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     163            ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
     164            iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     165            is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     166            is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    166167         ENDIF 
    167168          
    … …  
    173174         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    174175          
    175          CALL dia_wri_state( 'output.abort' )     ! create an output.abort file 
     176         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    176177          
    177178         IF( .NOT. ln_ctl ) THEN 
Note: See TracChangeset for help on using the changeset viewer.