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 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA – NEMO

Ignore:
Timestamp:
2019-11-22T15:29:17+01:00 (5 years ago)
Author:
acc
Message:

Merge in changes from 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. This just creates a fresh copy of this branch to use as the merge base. See ticket #2341

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src

    • Property svn:mergeinfo deleted

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/dia25h.F90

    r11536 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diaar5.F90

    r10425 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diacfl.F90

    r11532 r11949  
    4141CONTAINS 
    4242 
    43    SUBROUTINE dia_cfl ( kt ) 
     43   SUBROUTINE dia_cfl ( kt, Kmm ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                  ***  ROUTINE dia_cfl  *** 
    … …  
    4949      !!---------------------------------------------------------------------- 
    5050      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     51      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    5152      ! 
    5253      INTEGER                          ::   ji, jj, jk                       ! dummy loop indices 
    … …  
    6768         DO jj = 1, jpj 
    6869            DO ji = 1, jpi 
    69                zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    70                zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    71                zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
     70               zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
     71               zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
     72               zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * z2dt / e3w(ji,jj,jk,Kmm)   ! for k-direction 
    7273            END DO 
    7374         END DO          

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diadct.F90

    r11536 r11949  
    175175  
    176176  
    177   SUBROUTINE dia_dct( kt ) 
     177  SUBROUTINE dia_dct( kt, Kmm ) 
    178178     !!--------------------------------------------------------------------- 
    179179     !!               ***  ROUTINE diadct  ***   
    … …  
    192192     !!               Reinitialise all relevant arrays to zero  
    193193     !!--------------------------------------------------------------------- 
    194      INTEGER, INTENT(in) ::   kt 
     194     INTEGER, INTENT(in) ::   kt    ! ocean time step 
     195     INTEGER, INTENT(in) ::   Kmm   ! time level index 
    195196     ! 
    196197     INTEGER ::   jsec              ! loop on sections 
    … …  
    232233 
    233234           !Compute transport through section   
    234            CALL transport(secs(jsec),lldebug,jsec)  
     235           CALL transport(Kmm,secs(jsec),lldebug,jsec)  
    235236 
    236237        ENDDO 
    … …  
    246247           ! Sum over each class  
    247248           DO jsec=1,nb_sec  
    248               CALL dia_dct_sum(secs(jsec),jsec)  
     249              CALL dia_dct_sum(Kmm,secs(jsec),jsec)  
    249250           ENDDO  
    250251 
    … …  
    558559 
    559560 
    560    SUBROUTINE transport(sec,ld_debug,jsec) 
     561   SUBROUTINE transport(Kmm,sec,ld_debug,jsec) 
    561562     !!------------------------------------------------------------------------------------------- 
    562563     !!                     ***  ROUTINE transport  *** 
    … …  
    578579     !! 
    579580     !!------------------------------------------------------------------------------------------- 
     581     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    580582     TYPE(SECTION),INTENT(INOUT) :: sec 
    581583     LOGICAL      ,INTENT(IN)    :: ld_debug 
    … …  
    673675            SELECT CASE( sec%direction(jseg) ) 
    674676               CASE(0,1)  
    675                   ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    676                   zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    677                   zrhop = interp(k%I,k%J,jk,'V',rhop)  
    678                   zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
    679                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)  
     677                  ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     678                  zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     679                  zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     680                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
     681                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm)    ) * vmask(k%I,k%J,1)  
    680682               CASE(2,3)  
    681                   ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    682                   zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    683                   zrhop = interp(k%I,k%J,jk,'U',rhop)  
    684                   zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    685                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     683                  ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     684                  zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     685                  zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     686                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     687                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    686688               END SELECT  
    687689               ! 
    688                zdep= gdept_n(k%I,k%J,jk)  
     690               zdep= gdept(k%I,k%J,jk,Kmm)  
    689691   
    690692               SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction  
    691693               CASE(0,1)    
    692694                  zumid=0._wp 
    693                   zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk)  
     695                  zvmid=isgnv*vv(k%I,k%J,jk,Kmm)*vmask(k%I,k%J,jk)  
    694696               CASE(2,3)  
    695                   zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk)  
     697                  zumid=isgnu*uu(k%I,k%J,jk,Kmm)*umask(k%I,k%J,jk)  
    696698                  zvmid=0._wp 
    697699               END SELECT  
    … …  
    699701               !zTnorm=transport through one cell;  
    700702               !velocity* cell's length * cell's thickness  
    701                zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     &  
    702                   &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk)  
     703               zTnorm = zumid*e2u(k%I,k%J) * e3u(k%I,k%J,jk,Kmm)     &  
     704                  &   + zvmid*e1v(k%I,k%J) * e3v(k%I,k%J,jk,Kmm)  
    703705 
    704706!!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!! 
    … …  
    765767 
    766768 
    767   SUBROUTINE dia_dct_sum(sec,jsec)  
     769  SUBROUTINE dia_dct_sum(Kmm,sec,jsec)  
    768770     !!-------------------------------------------------------------  
    769771     !! Purpose: Average the transport over nn_dctwri time steps   
    … …  
    784786     !!  
    785787     !!-------------------------------------------------------------  
     788     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    786789     TYPE(SECTION),INTENT(INOUT) :: sec  
    787790     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section  
    … …  
    845848              SELECT CASE( sec%direction(jseg) )  
    846849              CASE(0,1)  
    847                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    848                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    849                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    850                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     850                 ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     851                 zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     852                 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     853                 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
    851854 
    852855              CASE(2,3)  
    853                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    854                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    855                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    856                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    857                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     856                 ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     857                 zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     858                 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     859                 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     860                 zsshn =  0.5*( ssh(k%I,k%J,Kmm)    + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    858861              END SELECT  
    859862  
    860               zdep= gdept_n(k%I,k%J,jk)  
     863              zdep= gdept(k%I,k%J,jk,Kmm)  
    861864   
    862865              !-------------------------------  
    … …  
    11011104 
    11021105 
    1103    FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     1106   FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab) 
    11041107  !!---------------------------------------------------------------------- 
    11051108  !! 
    … …  
    11621165  !!---------------------------------------------------------------------- 
    11631166  !*arguments 
     1167  INTEGER, INTENT(IN)                          :: Kmm          ! time level index 
    11641168  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point 
    11651169  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V) 
    … …  
    11961200  IF( ln_sco )THEN   ! s-coordinate case 
    11971201 
    1198      zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp  
    1199      zdep1 = gdept_n(ii1,ij1,kk) - zdepu 
    1200      zdep2 = gdept_n(ii2,ij2,kk) - zdepu 
     1202     zdepu = ( gdept(ii1,ij1,kk,Kmm) +  gdept(ii2,ij2,kk,Kmm) ) * 0.5_wp  
     1203     zdep1 = gdept(ii1,ij1,kk,Kmm) - zdepu 
     1204     zdep2 = gdept(ii2,ij2,kk,Kmm) - zdepu 
    12011205 
    12021206     ! weights 
    … …  
    12101214  ELSE       ! full step or partial step case  
    12111215 
    1212      ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)  
    1213      zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 
    1214      zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 
     1216     ze3t  = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm)  
     1217     zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm) 
     1218     zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm) 
    12151219 
    12161220     IF(kk .NE. 1)THEN 
    … …  
    12451249      IMPLICIT NONE 
    12461250   END SUBROUTINE dia_dct_init 
    1247    SUBROUTINE dia_dct( kt ) 
     1251 
     1252   SUBROUTINE dia_dct( kt, Kmm )         ! Dummy routine 
    12481253      IMPLICIT NONE 
    1249       INTEGER, INTENT(in) ::   kt 
     1254      INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
     1255      INTEGER, INTENT( in ) :: Kmm  ! ocean time level index 
     1256      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
    12501257   END SUBROUTINE dia_dct 
    12511258   ! 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaharm.F90

    r11536 r11949  
    163163 
    164164 
    165    SUBROUTINE dia_harm ( kt ) 
     165   SUBROUTINE dia_harm ( kt, Kmm ) 
    166166      !!---------------------------------------------------------------------- 
    167167      !!                 ***  ROUTINE dia_harm  *** 
    … …  
    173173      !!-------------------------------------------------------------------- 
    174174      INTEGER, INTENT( IN ) :: kt 
     175      INTEGER, INTENT( IN ) :: Kmm     ! time level index 
    175176      ! 
    176177      INTEGER  :: ji, jj, jh, jc, nhc 
    … …  
    193194                  DO ji = 1,jpi 
    194195                     ! Elevation 
    195                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
    196                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
    197                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     196                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*ssh(ji,jj,Kmm)*ssmask (ji,jj)         
     197                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*uu_b(ji,jj,Kmm)*ssumask(ji,jj) 
     198                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vv_b(ji,jj,Kmm)*ssvmask(ji,jj) 
    198199                  END DO 
    199200               END DO 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahsb.F90

    r11536 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diahth.F90

    r10425 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diaptr.F90

    r11536 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diatmb.F90

    r11536 r11949  
    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_r11943_MERGE_2019/src/OCE/DIA/diawri.F90

    r11536 r11949  
    5757   USE lib_mpp         ! MPP library 
    5858   USE timing          ! preformance summary 
    59    USE diurnal_bulk    ! diurnal warm layer 
    60    USE cool_skin       ! Cool skin 
     59   USE diu_bulk        ! diurnal warm layer 
     60   USE diu_coolskin    ! Cool skin 
    6161 
    6262   IMPLICIT NONE 
    … …  
    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 
    139          CALL iom_put( "ssh" , (sshn+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
     140         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+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       IF( ln_zad_Aimp ) wn = wn + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 
    213       ! 
    214       CALL iom_put( "woce", wn )                   ! vertical velocity 
     213      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 
     214      ! 
     215      CALL iom_put( "woce", ww )                   ! vertical velocity 
    215216      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    216217         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    217218         z2d(:,:) = rau0 * e1e2t(:,:) 
    218219         DO jk = 1, jpk 
    219             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     220            z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:) 
    220221         END DO 
    221222         CALL iom_put( "w_masstr" , z3d )   
    … …  
    223224      ENDIF 
    224225      ! 
    225       IF( ln_zad_Aimp ) wn = wn - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output 
     226      IF( ln_zad_Aimp ) ww = ww - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output 
    226227 
    227228      CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef. 
    … …  
    235236         DO jj = 2, jpjm1                                    ! sst gradient 
    236237            DO ji = fs_2, fs_jpim1   ! vector opt. 
    237                zztmp  = tsn(ji,jj,1,jp_tem) 
    238                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) 
    239                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) 
     238               zztmp  = ts(ji,jj,1,jp_tem,Kmm) 
     239               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) 
     240               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) 
    240241               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    241242                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    … …  
    254255            DO jj = 1, jpj 
    255256               DO ji = 1, jpi 
    256                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     257                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 
    257258               END DO 
    258259            END DO 
    … …  
    266267            DO jj = 1, jpj 
    267268               DO ji = 1, jpi 
    268                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     269                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
    269270               END DO 
    270271            END DO 
    … …  
    278279            DO jj = 2, jpjm1 
    279280               DO ji = fs_2, fs_jpim1   ! vector opt. 
    280                   zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    281                   z3d(ji,jj,jk) = zztmp * (  un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)   & 
    282                      &                     + un(ji  ,jj,jk)**2 * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)   & 
    283                      &                     + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)   & 
    284                      &                     + vn(ji,jj  ,jk)**2 * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk)   ) 
     281                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     282                  z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   & 
     283                     &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   & 
     284                     &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   & 
     285                     &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
    285286               END DO 
    286287            END DO 
    … …  
    290291      ENDIF 
    291292      ! 
    292       CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
     293      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence 
    293294      ! 
    294295      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    … …  
    296297         z2d(:,:) = 0.e0 
    297298         DO jk = 1, jpkm1 
    298             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     299            z3d(:,:,jk) = rau0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    299300            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    300301         END DO 
    … …  
    308309            DO jj = 2, jpjm1 
    309310               DO ji = fs_2, fs_jpim1   ! vector opt. 
    310                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     311                  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) ) 
    311312               END DO 
    312313            END DO 
    … …  
    321322            DO jj = 2, jpjm1 
    322323               DO ji = fs_2, fs_jpim1   ! vector opt. 
    323                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     324                  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) ) 
    324325               END DO 
    325326            END DO 
    … …  
    333334         z3d(:,:,jpk) = 0.e0 
    334335         DO jk = 1, jpkm1 
    335             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     336            z3d(:,:,jk) = rau0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    336337         END DO 
    337338         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction 
    … …  
    343344            DO jj = 2, jpjm1 
    344345               DO ji = fs_2, fs_jpim1   ! vector opt. 
    345                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     346                  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) ) 
    346347               END DO 
    347348            END DO 
    … …  
    356357            DO jj = 2, jpjm1 
    357358               DO ji = fs_2, fs_jpim1   ! vector opt. 
    358                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     359                  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) ) 
    359360               END DO 
    360361            END DO 
    … …  
    369370            DO jj = 2, jpjm1 
    370371               DO ji = fs_2, fs_jpim1   ! vector opt. 
    371                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
     372                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
    372373               END DO 
    373374            END DO 
    … …  
    381382            DO jj = 2, jpjm1 
    382383               DO ji = fs_2, fs_jpim1   ! vector opt. 
    383                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
     384                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    384385               END DO 
    385386            END DO 
    … …  
    392393      ! 
    393394 
    394       IF (ln_diatmb)   CALL dia_tmb                   ! tmb values  
     395      IF (ln_diatmb)   CALL dia_tmb( Kmm )            ! tmb values  
    395396           
    396       IF (ln_dia25h)   CALL dia_25h( kt )             ! 25h averaging 
     397      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging 
    397398 
    398399      IF( ln_timing )   CALL timing_stop('dia_wri') 
    … …  
    420421 
    421422    
    422    SUBROUTINE dia_wri( kt ) 
     423   SUBROUTINE dia_wri( kt, Kmm ) 
    423424      !!--------------------------------------------------------------------- 
    424425      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    433434      !!---------------------------------------------------------------------- 
    434435      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     436      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    435437      ! 
    436438      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    … …  
    448450      ! 
    449451      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    450          CALL dia_wri_state( 'output.init' ) 
     452         CALL dia_wri_state( Kmm, 'output.init' ) 
    451453         ninist = 0 
    452454      ENDIF 
    … …  
    589591            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    590592         IF(  .NOT.ln_linssh  ) THEN 
    591             CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n 
     593            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t(:,:,:,Kmm) 
    592594            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    593             CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n 
     595            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t(:,:,:,Kmm) 
    594596            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    595             CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n 
     597            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t(:,:,:,Kmm) 
    596598            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    597599         ENDIF 
    … …  
    610612            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    611613         IF(  ln_linssh  ) THEN 
    612             CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem) 
     614            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * ts(:,:,1,jp_tem,Kmm) 
    613615            &                                                                  , "KgC/m2/s",  &  ! sosst_cd 
    614616            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    615             CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * tsn(:,:,1,jp_sal) 
     617            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * ts(:,:,1,jp_sal,Kmm) 
    616618            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd 
    617619            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    689691 
    690692         !                                                                                      !!! nid_U : 3D 
    691          CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
     693         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! uu(:,:,:,Kmm) 
    692694            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    693695         IF( ln_wave .AND. ln_sdw) THEN 
    … …  
    702704 
    703705         !                                                                                      !!! nid_V : 3D 
    704          CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
     706         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vv(:,:,:,Kmm) 
    705707            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    706708         IF( ln_wave .AND. ln_sdw) THEN 
    … …  
    715717 
    716718         !                                                                                      !!! nid_W : 3D 
    717          CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
     719         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! ww 
    718720            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    719721         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    … …  
    753755 
    754756      IF( .NOT.ln_linssh ) THEN 
    755          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    756          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content 
    757          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
    758          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
     757         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! heat content 
     758         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! salt content 
     759         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface heat content 
     760         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity content 
    759761      ELSE 
    760          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature 
    761          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity 
    762          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature 
    763          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity 
     762         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature 
     763         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T  )   ! salinity 
     764         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT )   ! sea surface temperature 
     765         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity 
    764766      ENDIF 
    765767      IF( .NOT.ln_linssh ) THEN 
    766          zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    767          CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    768          CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
     768         zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
     769         CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm) , ndim_T , ndex_T  )   ! level thickness 
     770         CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T  )   ! t-point depth 
    769771         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation 
    770772      ENDIF 
    771       CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
     773      CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm)          , ndim_hT, ndex_hT )   ! sea surface height 
    772774      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux 
    773775      CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs 
    … …  
    776778                                                                                  ! in linear free surface case) 
    777779      IF( ln_linssh ) THEN 
    778          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
     780         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm) 
    779781         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    780          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
     782         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm) 
    781783         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    782784      ENDIF 
    … …  
    814816         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    815817         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    816          zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     818         zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
    817819         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    818820      ENDIF 
    … …  
    827829#endif 
    828830 
    829       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
     831      CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm)            , ndim_U , ndex_U )    ! i-current 
    830832      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    831833 
    832       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
     834      CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm)            , ndim_V , ndex_V  )   ! j-current 
    833835      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    834836 
    835837      IF( ln_zad_Aimp ) THEN 
    836          CALL histwrite( nid_W, "vovecrtz", it, wn + wi     , ndim_T, ndex_T )    ! vert. current 
     838         CALL histwrite( nid_W, "vovecrtz", it, ww + wi     , ndim_T, ndex_T )    ! vert. current 
    837839      ELSE 
    838          CALL histwrite( nid_W, "vovecrtz", it, wn          , ndim_T, ndex_T )    ! vert. current 
     840         CALL histwrite( nid_W, "vovecrtz", it, ww          , ndim_T, ndex_T )    ! vert. current 
    839841      ENDIF 
    840842      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    … …  
    864866#endif 
    865867 
    866    SUBROUTINE dia_wri_state( cdfile_name ) 
     868   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    867869      !!--------------------------------------------------------------------- 
    868870      !!                 ***  ROUTINE dia_wri_state  *** 
    … …  
    877879      !!      File 'output.abort.nc' is created in case of abnormal job end 
    878880      !!---------------------------------------------------------------------- 
     881      INTEGER           , INTENT( in ) ::   Kmm              ! time level index 
    879882      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    880883      !! 
    … …  
    893896#endif 
    894897 
    895       CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
    896       CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
    897       CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
    898       CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    899       CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
     898      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
     899      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
     900      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height 
     901      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity 
     902      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity 
    900903      IF( ln_zad_Aimp ) THEN 
    901          CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn + wi        )    ! now k-velocity 
     904         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity 
    902905      ELSE 
    903          CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn             )    ! now k-velocity 
     906         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity 
    904907      ENDIF 
    905908      IF( ALLOCATED(ahtu) ) THEN 
    … …  
    918921      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
    919922      IF(  .NOT.ln_linssh  ) THEN              
    920          CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n        )    !  T-cell depth  
    921          CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n          )    !  T-cell thickness   
     923         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth  
     924         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)          )    !  T-cell thickness   
    922925      END IF 
    923926      IF( ln_wave .AND. ln_sdw ) THEN 
Note: See TracChangeset for help on using the changeset viewer.