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

Changeset 10922


Ignore:
Timestamp:
2019-05-02T17:10:39+02:00 (4 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert IOM, LDF, OBS and SBC directories and compatibility changes elsewhere that these changes enforce. Changes pass SETTE and compare with original trunk results. Outstanding issues (currently with work-arounds) in DIU/step_diu.F90 and fld_bdy_interp within SBC/fldread.F90; proper soltions pending

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

Legend:

Unmodified
Added
Removed

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

    r10069 r10922  
    4949      INTEGER ::   indic    ! error indicator if < 0  
    5050      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc      
     51      INTEGER :: Nbb, Nnn, Naa, Nrhs    ! local definitions as placeholders for now 
    5152      !! ---------------------------------------------------------------------  
    5253       
    … …  
    6061         ENDIF 
    6162        
    62             CALL sbc    ( kstp )                      ! Sea Boundary Conditions  
     63            CALL sbc    ( kstp, Nbb, Nnn )            ! Sea Boundary Conditions  
    6364      ENDIF 
    6465      
    … …  
    7879 
    7980      IF( ln_diurnal_only ) THEN 
    80          IF( ln_diaobs )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     81         ! WILL HAVE TO INCREMENT Nbb and Nnn here in ln_diurnal_only case ! 
     82         IF( ln_diaobs )         CALL dia_obs( kstp, Nnn )    ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    8183      
    8284         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
    … …  
    8486         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    8587         IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file  
    86          IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
     88         IF( lrst_oce         )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file 
    8789      
    8890         IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset  

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

    r10499 r10922  
    5151CONTAINS 
    5252 
    53    SUBROUTINE istate_init 
     53   SUBROUTINE istate_init( Kbb, Kmm ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                   ***  ROUTINE istate_init  *** 
    … …  
    5757      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    5858      !!---------------------------------------------------------------------- 
     59      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    5960      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6061!!gm see comment further down 
    … …  
    8586      IF( ln_rstart ) THEN                    ! Restart from a file 
    8687         !                                    ! ------------------- 
    87          CALL rst_read                        ! Read the restart file 
     88         CALL rst_read( Kbb, Kmm )            ! Read the restart file 
    8889         IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry 
    8990         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    … …  
    124125         vn   (:,:,:)   = vb  (:,:,:) 
    125126         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    126          CALL div_hor( 0 )                    ! compute interior hdivn value   
     127         CALL div_hor( 0, Kmm )               ! compute interior hdivn value   
    127128!!gm                                    hdivn(:,:,:) = 0._wp 
    128129 

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

    r10425 r10922  
    4848CONTAINS 
    4949 
    50    SUBROUTINE div_hor( kt ) 
     50   SUBROUTINE div_hor( kt, Kmm ) 
    5151      !!---------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE div_hor  *** 
    … …  
    6161      !!---------------------------------------------------------------------- 
    6262      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     63      INTEGER, INTENT(in) ::   Kmm  ! ocean time-level index 
    6364      ! 
    6465      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    … …  
    9495#endif 
    9596      ! 
    96       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field) 
     97      IF( ln_rnf )   CALL sbc_rnf_div( hdivn, Kmm )                     !==  runoffs    ==!   (update hdivn field) 
    9798      ! 
    9899#if defined key_asminc  
    … …  
    100101      !  
    101102#endif 
    102       IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
     103      IF( ln_isf )   CALL sbc_isf_div( hdivn, Kmm )                     !==  ice shelf  ==!   (update hdivn field) 
    103104      ! 
    104       IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
     105      IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn )             !==  ice sheet  ==!   (update hdivn field) 
    105106      ! 
    106107      CALL lbc_lnk( 'divhor', hdivn, 'T', 1. )   !   (no sign change) 

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

    r10425 r10922  
    5454CONTAINS 
    5555 
    56    SUBROUTINE ssh_nxt( kt ) 
     56   SUBROUTINE ssh_nxt( kt, Kmm ) 
    5757      !!---------------------------------------------------------------------- 
    5858      !!                ***  ROUTINE ssh_nxt  *** 
    … …  
    6969      !!---------------------------------------------------------------------- 
    7070      INTEGER, INTENT(in) ::   kt   ! time step 
     71      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    7172      !  
    7273      INTEGER  ::   jk            ! dummy loop indice 
    … …  
    9495      ENDIF 
    9596 
    96       CALL div_hor( kt )                               ! Horizontal divergence 
     97      CALL div_hor( kt, Kmm )                          ! Horizontal divergence 
    9798      ! 
    9899      zhdiv(:,:) = 0._wp 

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

    r10425 r10922  
    131131 
    132132 
    133    SUBROUTINE rst_write( kt ) 
     133   SUBROUTINE rst_write( kt, Kbb, Kmm ) 
    134134      !!--------------------------------------------------------------------- 
    135135      !!                   ***  ROUTINE rstwrite  *** 
    … …  
    140140      !!              file, save fields which are necessary for restart 
    141141      !!---------------------------------------------------------------------- 
    142       INTEGER, INTENT(in) ::   kt   ! ocean time-step 
     142      INTEGER, INTENT(in) ::   kt         ! ocean time-step 
     143      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    143144      !!---------------------------------------------------------------------- 
    144145                     IF(lwxios) CALL iom_swap(      cwxios_context          ) 
    … …  
    147148 
    148149      IF ( .NOT. ln_diurnal_only ) THEN 
    149                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        ) 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios ) 
    152                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios ) 
     150                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:,Kbb), ldxios = lwxios        )     ! before fields 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:,Kbb), ldxios = lwxios        ) 
     152                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 
     153                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 
    153154                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      ) 
    154155                     ! 
    155                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        ) 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios ) 
    158                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios ) 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:,Kmm), ldxios = lwxios        )     ! now fields 
     157                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:,Kmm), ldxios = lwxios        ) 
     158                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 
     159                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 
    159160                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
    160161                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      ) 
    … …  
    165166                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 
    166167                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 
    167                      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction 
    168                      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    169                      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    170                      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 
     168                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios )   ! need to compute temperature correction 
     169                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u(:,:,:,Kmm), ldxios = lwxios )   ! need to compute bt conservation 
     170                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v(:,:,:,Kmm), ldxios = lwxios )   ! need to compute bt conservation 
     171                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm), ldxios = lwxios ) ! need to compute extrapolation if vvl 
    171172                  END IF 
    172173      ENDIF 
    … …  
    238239 
    239240 
    240    SUBROUTINE rst_read 
     241   SUBROUTINE rst_read( Kbb, Kmm ) 
    241242      !!----------------------------------------------------------------------  
    242243      !!                   ***  ROUTINE rst_read  *** 
    … …  
    246247      !! ** Method  :   Read in restart.nc file fields which are necessary for restart 
    247248      !!---------------------------------------------------------------------- 
     249      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    248250      REAL(wp) ::   zrdt 
    249251      INTEGER  ::   jk 
    … …  
    268270         rhop = rau0 
    269271         CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios )  
    270          tsn(:,:,1,jp_tem) = w3d(:,:,1) 
     272         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 
    271273         RETURN  
    272274      ENDIF   
    273275       
    274276      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    275          CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields 
    276          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                ) 
    277          CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lrxios ) 
    278          CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lrxios ) 
    279          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              ) 
     277         CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:,Kbb), ldxios = lrxios        )   ! before fields 
     278         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:,Kbb), ldxios = lrxios        ) 
     279         CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
     280         CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
     281         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios                 ) 
    280282      ELSE 
    281283         neuler = 0 
    282284      ENDIF 
    283285      ! 
    284       CALL iom_get( numror, jpdom_autoglo, 'un'     , un, ldxios = lrxios )   ! now    fields 
    285       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, ldxios = lrxios ) 
    286       CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lrxios ) 
    287       CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lrxios ) 
     286      CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:,Kmm), ldxios = lrxios        )   ! now    fields 
     287      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:,Kmm), ldxios = lrxios        ) 
     288      CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
     289      CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
    288290      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios ) 
    289291      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    290292         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    291293      ELSE 
    292          CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )    
     294         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )    
    293295      ENDIF 
    294296      ! 
    295297      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    296          tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
    297          ub   (:,:,:)   = un   (:,:,:) 
    298          vb   (:,:,:)   = vn   (:,:,:) 
    299          sshb (:,:)     = sshn (:,:) 
     298         ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
     299         uu   (:,:,:,Kbb)   = uu   (:,:,:,Kmm) 
     300         vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm) 
     301         sshb (:,:)         = sshn (:,:) 
    300302         ! 
    301303         IF( .NOT.ln_linssh ) THEN 
    302304            DO jk = 1, jpk 
    303                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     305               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    304306            END DO 
    305307         ENDIF 

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

    r10425 r10922  
    339339 
    340340 
    341    SUBROUTINE ldf_dyn( kt ) 
     341   SUBROUTINE ldf_dyn( kt, Kbb ) 
    342342      !!---------------------------------------------------------------------- 
    343343      !!                  ***  ROUTINE ldf_dyn  *** 
    … …  
    357357      !!---------------------------------------------------------------------- 
    358358      INTEGER, INTENT(in) ::   kt   ! time step index 
     359      INTEGER, INTENT(in) ::   Kbb  ! ocean time level indices 
    359360      ! 
    360361      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    373374               DO jj = 2, jpjm1 
    374375                  DO ji = fs_2, fs_jpim1 
    375                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    376                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    377                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
     376                     zu2pv2_ij_p1 = uu(ji  ,jj+1,jk,Kbb) * uu(ji  ,jj+1,jk,Kbb) + vv(ji+1,jj  ,jk,Kbb) * vv(ji+1,jj  ,jk,Kbb) 
     377                     zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     378                     zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
    378379                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    379380                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    … …  
    387388               DO jj = 2, jpjm1 
    388389                  DO ji = fs_2, fs_jpim1 
    389                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    390                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    391                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
     390                     zu2pv2_ij_p1 = uu(ji  ,jj+1,jk,Kbb) * uu(ji  ,jj+1,jk,Kbb) + vv(ji+1,jj  ,jk,Kbb) * vv(ji+1,jj  ,jk,Kbb) 
     391                     zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     392                     zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
    392393                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    393394                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    … …  
    415416               DO jj = 2, jpj 
    416417                  DO ji = 2, jpi 
    417                      zdb = ( (  ub(ji,jj,jk) * r1_e2u(ji,jj) -  ub(ji-1,jj,jk) * r1_e2u(ji-1,jj) )  & 
     418                     zdb = ( (  uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) -  uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) )  & 
    418419                          &                  * r1_e1t(ji,jj) * e2t(ji,jj)                           & 
    419                           & - ( vb(ji,jj,jk) * r1_e1v(ji,jj) -  vb(ji,jj-1,jk) * r1_e1v(ji,jj-1) )  & 
     420                          & - ( vv(ji,jj,jk,Kbb) * r1_e1v(ji,jj) -  vv(ji,jj-1,jk,Kbb) * r1_e1v(ji,jj-1) )  & 
    420421                          &                  * r1_e2t(ji,jj) * e1t(ji,jj)    ) * tmask(ji,jj,jk) 
    421422                     dtensq(ji,jj) = zdb * zdb 
    … …  
    425426               DO jj = 1, jpjm1 
    426427                  DO ji = 1, jpim1 
    427                      zdb = ( (  ub(ji,jj+1,jk) * r1_e1u(ji,jj+1) -  ub(ji,jj,jk) * r1_e1u(ji,jj) )  & 
     428                     zdb = ( (  uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) -  uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) )  & 
    428429                          &                    * r1_e2f(ji,jj)   * e1f(ji,jj)                       & 
    429                           & + ( vb(ji+1,jj,jk) * r1_e2v(ji+1,jj) -  vb(ji,jj,jk) * r1_e2v(ji,jj) )  & 
     430                          & + ( vv(ji+1,jj,jk,Kbb) * r1_e2v(ji+1,jj) -  vv(ji,jj,jk,Kbb) * r1_e2v(ji,jj) )  & 
    430431                          &                    * r1_e1f(ji,jj)   * e2f(ji,jj)  ) * fmask(ji,jj,jk) 
    431432                     dshesq(ji,jj) = zdb * zdb 
    … …  
    436437                  DO ji = fs_2, fs_jpim1 
    437438                     ! 
    438                      zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk) 
    439                      zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk) 
    440                      zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk) 
     439                     zu2pv2_ij_p1 = uu(ji  ,jj+1,jk,Kbb) * uu(ji  ,jj+1,jk,Kbb) + vv(ji+1,jj  ,jk,Kbb) * vv(ji+1,jj  ,jk,Kbb) 
     440                     zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
     441                     zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
    441442                                                     ! T-point value 
    442443                     zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2 

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

    r10425 r10922  
    8181CONTAINS 
    8282 
    83    SUBROUTINE ldf_slp( kt, prd, pn2 ) 
     83   SUBROUTINE ldf_slp( kt, prd, pn2, Kbb, Kmm ) 
    8484      !!---------------------------------------------------------------------- 
    8585      !!                 ***  ROUTINE ldf_slp  *** 
    … …  
    107107      !!---------------------------------------------------------------------- 
    108108      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
     109      INTEGER , INTENT(in)                   ::   Kbb, Kmm   ! ocean time level indices 
    109110      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density 
    110111      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.) 
    … …  
    171172      ! 
    172173      !                          !==   Slopes just below the mixed layer   ==! 
    173       CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
     174      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr, Kmm )        ! output: uslpml, vslpml, wslpiml, wslpjml 
    174175 
    175176 
    … …  
    205206               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    206207               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    207                zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau )  ) 
    208                zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav )  ) 
     208               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u(ji,jj,jk,Kmm)* ABS( zau )  ) 
     209               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v(ji,jj,jk,Kmm)* ABS( zav )  ) 
    209210               !                                      ! uslp and vslp output in zwz and zww, resp. 
    210211               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
    211212               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
    212213               ! thickness of water column between surface and level k at u/v point 
    213                zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj,jk) )                            & 
    214                                 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj))   ) 
    215                zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) )                            & 
    216                                 - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj))   ) 
     214               zdepu = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji+1,jj,jk,Kmm) )                            & 
     215                                - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u(ji,jj,miku(ji,jj),Kmm)   ) 
     216               zdepv = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji,jj+1,jk,Kmm) )                            & 
     217                                - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v(ji,jj,mikv(ji,jj),Kmm)   ) 
    217218               ! 
    218219               zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     & 
    … …  
    224225!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
    225226!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
    226 !               zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
    227 !               zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
     227!               zci = 0.5 * ( gdept(ji+1,jj,jk,Kmm)+gdept(ji,jj,jk,Kmm) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
     228!               zcj = 0.5 * ( gdept(ji,jj+1,jk,Kmm)+gdept(ji,jj,jk,Kmm) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
    228229!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
    229230!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
    … …  
    296297               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    297298               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    298                zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai )  ) 
    299                zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj )  ) 
     299               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w(ji,jj,jk,Kmm)* ABS( zai )  ) 
     300               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w(ji,jj,jk,Kmm)* ABS( zaj )  ) 
    300301               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    301302               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    302                zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp ) 
     303               zck = ( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) ) / MAX( hmlp(ji,jj) - gdepw(ji,jj,mikt(ji,jj),Kmm), 10._wp ) 
    303304               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    304305               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    … …  
    375376 
    376377 
    377    SUBROUTINE ldf_slp_triad ( kt ) 
     378   SUBROUTINE ldf_slp_triad ( kt, Kbb, Kmm ) 
    378379      !!---------------------------------------------------------------------- 
    379380      !!                 ***  ROUTINE ldf_slp_triad  *** 
    … …  
    390391      !!---------------------------------------------------------------------- 
    391392      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
     393      INTEGER , INTENT(in)  ::   Kbb, Kmm       ! ocean time level indices 
    392394      !! 
    393395      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
    … …  
    419421            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set 
    420422               DO ji = 1, fs_jpim1            ! vector opt. 
    421                   zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point 
    422                   zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    423                   zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    424                   zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
     423                  zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point 
     424                  zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) 
     425                  zdjt = ( ts(ji,jj+1,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! j-gradient of T & S at v-point 
     426                  zdjs = ( ts(ji,jj+1,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) 
    425427                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj) 
    426428                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj) 
    … …  
    452454               DO ji = 1, jpi                 ! vector opt. 
    453455                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp 
    454                      zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) ) 
    455                      zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) ) 
     456                     zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) 
     457                     zdks = ( ts(ji,jj,jk+kp-1,jp_sal,Kbb) - ts(ji,jj,jk+kp,jp_sal,Kbb) ) 
    456458                  ELSE 
    457459                     zdkt = 0._wp                                             ! 1st level gradient set to zero 
    … …  
    460462                  zdzrho_raw = ( - rab_b(ji,jj,jk+kp,jp_tem) * zdkt &  
    461463                             &   + rab_b(ji,jj,jk+kp,jp_sal) * zdks & 
    462                              & ) / e3w_n(ji,jj,jk+kp)   
     464                             & ) / e3w(ji,jj,jk+kp,Kmm)   
    463465                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln 
    464466                 END DO 
    … …  
    470472         DO ji = 1, jpi 
    471473            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    472             z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk) 
     474            z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) 
    473475         END DO 
    474476      END DO 
    … …  
    499501                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    500502                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    501                         &          - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
    502                      ze3_e1    =  e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)  
     503                        &          - ( gdept(ji+1,jj,jk-kp,Kmm) - gdept(ji,jj,jk-kp,Kmm) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
     504                     ze3_e1    =  e3w(ji+ip,jj,jk-kp,Kmm) * r1_e1u(ji,jj)  
    503505                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw ) 
    504506                  ENDIF 
    … …  
    509511                  ELSE 
    510512                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    511                         &      - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    512                      ze3_e2    =  e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj) 
     513                        &      - ( gdept(ji,jj+1,jk-kp,Kmm) - gdept(ji,jj,jk-kp,Kmm) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     514                     ze3_e2    =  e3w(ji,jj+jp,jk-kp,Kmm) / e2v(ji,jj) 
    513515                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw ) 
    514516                  ENDIF 
    … …  
    542544                     ! 
    543545                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    544                      zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj  ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) 
    545                      ztj_coord = znot_thru_surface * ( gdept_n(ji  ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked 
     546                     zti_coord = znot_thru_surface * ( gdept(ji+1,jj  ,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) 
     547                     ztj_coord = znot_thru_surface * ( gdept(ji  ,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj)     ! unmasked 
    546548                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    547549                     ztj_g_raw = ztj_raw - ztj_coord 
    548550                     ! additional limit required in bilaplacian case 
    549                      ze3_e1    = e3w_n(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj) 
    550                      ze3_e2    = e3w_n(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj) 
     551                     ze3_e1    = e3w(ji+ip,jj   ,jk+kp,Kmm) * r1_e1u(ji,jj) 
     552                     ze3_e2    = e3w(ji   ,jj+jp,jk+kp,Kmm) * r1_e2v(ji,jj) 
    551553                     ! NB: hard coded factor 5 (can be a namelist parameter...) 
    552554                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 
    … …  
    561563                     zti_g_lim =          ( zfacti   * zti_g_lim                       & 
    562564                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   & 
    563                         &                           * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 
     565                        &                           * gdepw(ji+ip,jj,jk+kp,Kmm) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 
    564566                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       & 
    565567                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   & 
    566                         &                           * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 
     568                        &                           * gdepw(ji,jj+jp,jk+kp,Kmm) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 
    567569                     ! 
    568570                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim 
    … …  
    596598                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 
    597599                     ! 
    598                      zbu  = e1e2u(ji   ,jj   ) * e3u_n(ji   ,jj   ,jk   ) 
    599                      zbv  = e1e2v(ji   ,jj   ) * e3v_n(ji   ,jj   ,jk   ) 
    600                      zbti = e1e2t(ji+ip,jj   ) * e3w_n(ji+ip,jj   ,jk+kp) 
    601                      zbtj = e1e2t(ji   ,jj+jp) * e3w_n(ji   ,jj+jp,jk+kp) 
     600                     zbu  = e1e2u(ji   ,jj   ) * e3u(ji   ,jj   ,jk   ,Kmm) 
     601                     zbv  = e1e2v(ji   ,jj   ) * e3v(ji   ,jj   ,jk   ,Kmm) 
     602                     zbti = e1e2t(ji+ip,jj   ) * e3w(ji+ip,jj   ,jk+kp,Kmm) 
     603                     zbtj = e1e2t(ji   ,jj+jp) * e3w(ji   ,jj+jp,jk+kp,Kmm) 
    602604                     ! 
    603605                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked 
    … …  
    618620 
    619621 
    620    SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr ) 
     622   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr, Kmm ) 
    621623      !!---------------------------------------------------------------------- 
    622624      !!                  ***  ROUTINE ldf_slp_mxl  *** 
    … …  
    638640      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts) 
    639641      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point) 
     642      INTEGER , INTENT(in)                   ::   Kmm            ! ocean time level indices 
    640643      !! 
    641644      INTEGER  ::   ji , jj , jk                   ! dummy loop indices 
    … …  
    694697            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    695698            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    696             zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau )  ) 
    697             zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav )  ) 
     699            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u(ji,jj,iku,Kmm)* ABS( zau )  ) 
     700            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v(ji,jj,ikv,Kmm)* ABS( zav )  ) 
    698701            !                        !- Slope at u- & v-points (uslpml, vslpml) 
    699702            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 
    … …  
    717720            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    718721            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    719             zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai )  ) 
    720             zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj )  ) 
     722            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w(ji,jj,ik,Kmm)* ABS( zai )  ) 
     723            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w(ji,jj,ik,Kmm)* ABS( zaj )  ) 
    721724            !                        !- i- & j-slope at w-points (wslpiml, wslpjml) 
    722725            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 
    … …  
    786789!               DO jj = 2, jpjm1 
    787790!                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    788 !                     uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    789 !                     vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    790 !                     wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 
    791 !                     wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     791!                     uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kmm) - gdept(ji ,jj ,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     792!                     vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kmm) - gdept(ji ,jj ,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     793!                     wslpi(ji,jj,jk) = - ( gdepw(ji+1,jj,jk,Kmm) - gdepw(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 
     794!                     wslpj(ji,jj,jk) = - ( gdepw(ji,jj+1,jk,Kmm) - gdepw(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 
    792795!                  END DO 
    793796!               END DO 

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

    r10425 r10922  
    382382 
    383383 
    384    SUBROUTINE ldf_tra( kt ) 
     384   SUBROUTINE ldf_tra( kt, Kbb, Kmm ) 
    385385      !!---------------------------------------------------------------------- 
    386386      !!                  ***  ROUTINE ldf_tra  *** 
    … …  
    403403      !!---------------------------------------------------------------------- 
    404404      INTEGER, INTENT(in) ::   kt   ! time step 
     405      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    405406      ! 
    406407      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    411412         !                                ! =F(growth rate of baroclinic instability) 
    412413         !                                ! max value aeiv_0 ; decreased to 0 within 20N-20S 
    413          CALL ldf_eiv( kt, aei0, aeiu, aeiv ) 
     414         CALL ldf_eiv( kt, aei0, aeiu, aeiv, Kmm ) 
    414415      ENDIF 
    415416      ! 
    … …  
    424425            ahtv(:,:,1) = aeiv(:,:,1) 
    425426         ELSE                                            ! compute aht.  
    426             CALL ldf_eiv( kt, aht0, ahtu, ahtv ) 
     427            CALL ldf_eiv( kt, aht0, ahtu, ahtv, Kmm ) 
    427428         ENDIF 
    428429         ! 
    … …  
    448449         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12 
    449450            DO jk = 1, jpkm1 
    450                ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12   ! n.b. ub,vb are masked 
    451                ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
     451               ahtu(:,:,jk) = ABS( uu(:,:,jk,Kbb) ) * e1u(:,:) * r1_12   ! n.b. uu,vv are masked 
     452               ahtv(:,:,jk) = ABS( vv(:,:,jk,Kbb) ) * e2v(:,:) * r1_12 
    452453            END DO 
    453454         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 
    454455            DO jk = 1, jpkm1 
    455                ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
    456                ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
     456               ahtu(:,:,jk) = SQRT(  ABS( uu(:,:,jk,Kbb) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
     457               ahtv(:,:,jk) = SQRT(  ABS( vv(:,:,jk,Kbb) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
    457458            END DO 
    458459         ENDIF 
    … …  
    625626 
    626627 
    627    SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv ) 
     628   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv, Kmm ) 
    628629      !!---------------------------------------------------------------------- 
    629630      !!                  ***  ROUTINE ldf_eiv  *** 
    … …  
    637638      !!---------------------------------------------------------------------- 
    638639      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index 
     640      INTEGER                         , INTENT(in   ) ::   Kmm            ! ocean time level indices 
    639641      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s] 
    640642      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s] 
    … …  
    658660                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
    659661                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    660                   zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 
     662                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm) 
    661663                  ! Compute elements required for the inverse time scale of baroclinic 
    662664                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
    663665                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    664                   ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
     666                  ze3w = e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    665667                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 
    666668                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
    … …  
    676678                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
    677679                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    678                   zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 
     680                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm) 
    679681                  ! Compute elements required for the inverse time scale of baroclinic 
    680682                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
    681683                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    682                   ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 
     684                  ze3w = e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    683685                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    684686                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 
    … …  
    725727 
    726728 
    727    SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype ) 
     729   SUBROUTINE ldf_eiv_trp( kt, kit000, pu, pv, pw, cdtype, Kmm ) 
    728730      !!---------------------------------------------------------------------- 
    729731      !!                  ***  ROUTINE ldf_eiv_trp  *** 
    … …  
    741743      !!                                    velocity and heat transport (call ldf_eiv_dia) 
    742744      !! 
    743       !! ** Action  : pun, pvn increased by the eiv transport 
     745      !! ** Action  : pu, pv increased by the eiv transport 
    744746      !!---------------------------------------------------------------------- 
    745747      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
    746748      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index 
     749      INTEGER                         , INTENT(in   ) ::   Kmm      ! ocean time level indices 
    747750      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    748       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s] 
    749       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s] 
    750       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s] 
     751      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu      ! in : 3 ocean transport components   [m3/s] 
     752      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv      ! out: 3 ocean transport components   [m3/s] 
     753      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw      ! increased by the eiv                [m3/s] 
    751754      !! 
    752755      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    … …  
    780783         DO jj = 1, jpjm1 
    781784            DO ji = 1, fs_jpim1   ! vector opt.                
    782                pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    783                pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
     785               pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
     786               pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    784787            END DO 
    785788         END DO 
    … …  
    788791         DO jj = 2, jpjm1 
    789792            DO ji = fs_2, fs_jpim1   ! vector opt. 
    790                pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
     793               pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
    791794                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
    792795            END DO 
    … …  
    795798      ! 
    796799      !                              ! diagnose the eddy induced velocity and associated heat transport 
    797       IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
     800      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    798801      ! 
    799802    END SUBROUTINE ldf_eiv_trp 
    800803 
    801804 
    802    SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw ) 
     805   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw, Kmm ) 
    803806      !!---------------------------------------------------------------------- 
    804807      !!                  ***  ROUTINE ldf_eiv_dia  *** 
    … …  
    811814      !!---------------------------------------------------------------------- 
    812815      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
     816      INTEGER                         , INTENT(in   ) ::   Kmm   ! ocean time level indices 
    813817      ! 
    814818      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    … …  
    831835      ! 
    832836      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    833          zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 
     837         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u(:,:,jk,Kmm) ) 
    834838      END DO 
    835839      CALL iom_put( "uoce_eiv", zw3d ) 
    836840      ! 
    837841      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    838          zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 
     842         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v(:,:,jk,Kmm) ) 
    839843      END DO 
    840844      CALL iom_put( "voce_eiv", zw3d ) 
    … …  
    859863           DO jj = 2, jpjm1 
    860864              DO ji = fs_2, fs_jpim1   ! vector opt. 
    861                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    862                     &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     865                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   & 
     866                    &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji+1,jj,jk,jp_tem,Kmm) )  
    863867                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    864868              END DO 
    … …  
    875879         DO jj = 2, jpjm1 
    876880            DO ji = fs_2, fs_jpim1   ! vector opt. 
    877                zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
    878                   &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) )  
     881               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   & 
     882                  &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji,jj+1,jk,jp_tem,Kmm) )  
    879883               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    880884            END DO 
    … …  
    894898           DO jj = 2, jpjm1 
    895899              DO ji = fs_2, fs_jpim1   ! vector opt. 
    896                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    897                     &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
     900                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   & 
     901                    &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji+1,jj,jk,jp_sal,Kmm) )  
    898902                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    899903              END DO 
    … …  
    903907        CALL lbc_lnk( 'ldftra', zw3d, 'U', -1. ) 
    904908        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    905         CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
     909        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                ! salt transport in i-direction 
    906910      ENDIF 
    907911      zw2d(:,:) = 0._wp  
    … …  
    910914         DO jj = 2, jpjm1 
    911915            DO ji = fs_2, fs_jpim1   ! vector opt. 
    912                zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
    913                   &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) )  
     916               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   & 
     917                  &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji,jj+1,jk,jp_sal,Kmm) )  
    914918               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    915919            END DO 

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

    r10068 r10922  
    103103CONTAINS 
    104104 
    105    SUBROUTINE dia_obs_init 
     105   SUBROUTINE dia_obs_init( Kmm ) 
    106106      !!---------------------------------------------------------------------- 
    107107      !!                    ***  ROUTINE dia_obs_init  *** 
    … …  
    114114      !! 
    115115      !!---------------------------------------------------------------------- 
    116       INTEGER, PARAMETER ::   jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     116      INTEGER, INTENT(in)                ::   Kmm                      ! ocean time level indices 
     117      INTEGER, PARAMETER                 ::   jpmaxnfiles = 1000       ! Maximum number of files for each obs type 
    117118      INTEGER, DIMENSION(:), ALLOCATABLE ::   ifilesprof, ifilessurf   ! Number of profile & surface files 
    118119      INTEGER :: ios             ! Local integer output status for namelist read 
    … …  
    429430               &               jpi, jpj, jpk, & 
    430431               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    431                &               ln_nea, ln_bound_reject, & 
     432               &               ln_nea, ln_bound_reject, Kmm, & 
    432433               &               kdailyavtypes = nn_profdavtypes ) 
    433434         END DO 
    … …  
    483484 
    484485 
    485    SUBROUTINE dia_obs( kstp ) 
     486   SUBROUTINE dia_obs( kstp, Kmm ) 
    486487      !!---------------------------------------------------------------------- 
    487488      !!                    ***  ROUTINE dia_obs  *** 
    … …  
    496497      !! ** Action  : 
    497498      !!---------------------------------------------------------------------- 
    498       USE dom_oce, ONLY : gdept_n, gdept_1d   ! Ocean space and time domain variables 
     499      USE dom_oce, ONLY : gdept, gdept_1d     ! Ocean space domain variables (Kmm time-level only) 
    499500      USE phycst , ONLY : rday                ! Physical constants 
    500       USE oce    , ONLY : tsn, un, vn, sshn   ! Ocean dynamics and tracers variables 
     501      USE oce    , ONLY : ts, uu, vv, sshn    ! Ocean dynamics and tracers variables (Kmm time-level only) 
    501502      USE phycst , ONLY : rday                ! Physical constants 
    502503#if defined  key_si3 
    … …  
    511512      !! * Arguments 
    512513      INTEGER, INTENT(IN) :: kstp  ! Current timestep 
     514      INTEGER, INTENT(in) :: Kmm   ! ocean time level indices 
    513515      !! * Local declarations 
    514516      INTEGER :: idaystp           ! Number of timesteps per day 
    … …  
    551553            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
    552554            CASE('prof') 
    553                zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
    554                zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
     555               zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm) 
     556               zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    555557               zprofmask1(:,:,:) = tmask(:,:,:) 
    556558               zprofmask2(:,:,:) = tmask(:,:,:) 
    … …  
    560562               zgphi2(:,:) = gphit(:,:) 
    561563            CASE('vel') 
    562                zprofvar1(:,:,:) = un(:,:,:) 
    563                zprofvar2(:,:,:) = vn(:,:,:) 
     564               zprofvar1(:,:,:) = uu(:,:,:,Kmm) 
     565               zprofvar2(:,:,:) = vv(:,:,:,Kmm) 
    564566               zprofmask1(:,:,:) = umask(:,:,:) 
    565567               zprofmask2(:,:,:) = vmask(:,:,:) 
    … …  
    575577               &               nit000, idaystp,                         & 
    576578               &               zprofvar1, zprofvar2,                    & 
    577                &               gdept_n(:,:,:), gdepw_n(:,:,:),            &  
     579               &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
    578580               &               zprofmask1, zprofmask2,                  & 
    579581               &               zglam1, zglam2, zgphi1, zgphi2,          & 
    … …  
    594596            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
    595597            CASE('sst') 
    596                zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
     598               zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm) 
    597599            CASE('sla') 
    598600               zsurfvar(:,:) = sshn(:,:) 
    599601            CASE('sss') 
    600                zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
     602               zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm) 
    601603            CASE('sic') 
    602604               IF ( kstp == 0 ) THEN 

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

    r10068 r10922  
    244244      &                     kpi, kpj, kpk, & 
    245245      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
    246       &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
     246      &                     ld_nea, ld_bound_reject, Kmm, kdailyavtypes,  kqc_cutoff ) 
    247247 
    248248!!---------------------------------------------------------------------- 
    … …  
    274274      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
    275275      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes 
     276      INTEGER, INTENT(IN) :: Kmm                  ! time-level index 
    276277      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    277278         & kdailyavtypes                          ! Types for daily averages 
    … …  
    420421         &                 inlav1obs,             ld_nea,               & 
    421422         &                 ibdyv1obs,             ld_bound_reject,      & 
    422          &                 iqc_cutoff       ) 
     423         &                 iqc_cutoff,            Kmm                 ) 
    423424 
    424425      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
    … …  
    442443         &                 inlav2obs,             ld_nea,               & 
    443444         &                 ibdyv2obs,             ld_bound_reject,      & 
    444          &                 iqc_cutoff       ) 
     445         &                 iqc_cutoff,            Kmm                 ) 
    445446 
    446447      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
    … …  
    10941095      &                       klanobs, knlaobs, ld_nea,         & 
    10951096      &                       kbdyobs, ld_bound_reject,         & 
    1096       &                       kqc_cutoff                        ) 
     1097      &                       kqc_cutoff,       Kmm             ) 
    10971098      !!---------------------------------------------------------------------- 
    10981099      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    11161117      !!---------------------------------------------------------------------- 
    11171118      !! * Modules used 
    1118       USE dom_oce, ONLY : &       ! Geographical information 
     1119      USE dom_oce, ONLY : &       ! Geographical information  
    11191120         & gdepw_1d,      & 
    11201121         & gdepw_0,       &                        
    1121          & gdepw_n,       & 
    1122          & gdept_n,       & 
     1122         & gdepw,         & 
     1123         & gdept,         & 
    11231124         & ln_zco,        & 
    11241125         & ln_zps              
    … …  
    11601161      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
    11611162      INTEGER, INTENT(IN) :: kqc_cutoff     ! Cutoff QC value 
     1163      INTEGER, INTENT(IN) :: Kmm            ! time-level index 
    11621164 
    11631165      !! * Local declarations 
    … …  
    12301232      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
    12311233      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    1232       CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), & 
     1234      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw(:,:,:,Kmm), & 
    12331235        &                     zgdepw ) 
    12341236 

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

    r10425 r10922  
    4646   PUBLIC   fld_clopn 
    4747 
     48   INTEGER :: nfld_Nnn = 1 
    4849   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
    4950      CHARACTER(len = 256) ::   clname      ! generic name of the NetCDF flux file 
    … …  
    902903                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    903904                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    904                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t_n(zij,zjj,:), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     905                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
    905906                  ENDIF 
    906907               CASE(2) 
    … …  
    908909                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    909910                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    910                      IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u_n(zij,zjj,:), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
     911                     IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u(zij,zjj,:,nfld_Nnn), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
    911912                       &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , & 
    912913                        &                dta_read(map%ptr(ib),1,:) 
    … …  
    921922               SELECT CASE( igrd )                        
    922923                  CASE(1) 
    923                      zl =  gdept_n(zij,zjj,ik)                                          ! if using in step could use fsdept instead of gdept_n? 
     924                     zl =  gdept(zij,zjj,ik,nfld_Nnn)                                          ! if using in step could use fsdept instead of gdept_n? 
    924925                  CASE(2) 
    925926                     IF(ln_sco) THEN 
    926                         zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij+1,zjj,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     927                        zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    927928                     ELSE 
    928                         zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij+1,zjj,ik) )  
     929                        zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) )  
    929930                     ENDIF 
    930931                  CASE(3) 
    931932                     IF(ln_sco) THEN 
    932                         zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij,zjj+1,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     933                        zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    933934                     ELSE 
    934                         zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij,zjj+1,ik) ) 
     935                        zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
    935936                     ENDIF 
    936937               END SELECT 
    … …  
    940941                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,MAXLOC(dta_read_z(map%ptr(ib),1,:),1)) 
    941942               ELSE                                                                                ! inbetween : vertical interpolation between ikk & ikk+1 
    942                   DO ikk = 1, jpkm1_bdy                                                            ! when  gdept_n(ikk) < zl < gdept_n(ikk+1) 
     943                  DO ikk = 1, jpkm1_bdy                                                            ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
    943944                     IF( ( (zl-dta_read_z(map%ptr(ib),1,ikk)) * (zl-dta_read_z(map%ptr(ib),1,ikk+1)) <= 0._wp) & 
    944945                    &    .AND. (dta_read_z(map%ptr(ib),1,ikk+1) /= fv_alt)) THEN 
    … …  
    964965              ENDDO 
    965966              DO ik = 1, ipk                                ! calculate transport on model grid 
    966                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u_n(zij,zjj,ik) * umask(zij,zjj,ik) 
     967                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
    967968              ENDDO 
    968969              DO ik = 1, ipk                                ! make transport correction 
    … …  
    989990              ENDDO 
    990991              DO ik = 1, ipk                                ! calculate transport on model grid 
    991                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v_n(zij,zjj,ik) * vmask(zij,zjj,ik) 
     992                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
    992993              ENDDO 
    993994              DO ik = 1, ipk                                ! make transport correction 
    … …  
    10271028                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10281029                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    1029                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t_n(zij,zjj,:), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     1030                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
    10301031                  ENDIF 
    10311032               CASE(2) 
    … …  
    10431044               SELECT CASE( igrd )                          ! coded for sco - need zco and zps option using min 
    10441045                  CASE(1) 
    1045                      zl =  gdept_n(zij,zjj,ik)              ! if using in step could use fsdept instead of gdept_n? 
     1046                     zl =  gdept(zij,zjj,ik,nfld_Nnn)              ! if using in step could use fsdept instead of gdept_n? 
    10461047                  CASE(2) 
    10471048                     IF(ln_sco) THEN 
    1048                         zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij+1,zjj,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1049                        zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10491050                     ELSE 
    1050                         zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij+1,zjj,ik) ) 
     1051                        zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) ) 
    10511052                     ENDIF 
    10521053                  CASE(3) 
    10531054                     IF(ln_sco) THEN 
    1054                         zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij,zjj+1,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1055                        zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10551056                     ELSE 
    1056                         zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij,zjj+1,ik) ) 
     1057                        zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
    10571058                     ENDIF 
    10581059               END SELECT 
    … …  
    10621063                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 
    10631064               ELSE                                                                     ! inbetween : vertical interpolation between ikk & ikk+1 
    1064                   DO ikk = 1, jpkm1_bdy                                                 ! when  gdept_n(ikk) < zl < gdept_n(ikk+1) 
     1065                  DO ikk = 1, jpkm1_bdy                                                 ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
    10651066                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp) & 
    10661067                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 
    … …  
    10881089               ENDDO 
    10891090               DO ik = 1, ipk                                ! calculate transport on model grid 
    1090                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u_n(zij,zjj,ik) * umask(zij,zjj,ik) 
     1091                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
    10911092               ENDDO 
    10921093               DO ik = 1, ipk                                ! make transport correction 
    … …  
    11131114               ENDDO 
    11141115               DO ik = 1, ipk                                ! calculate transport on model grid 
    1115                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v_n(zij,zjj,ik) * vmask(zij,zjj,ik) 
     1116                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
    11161117               ENDDO 
    11171118               DO ik = 1, ipk                                ! make transport correction 

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

    r10617 r10922  
    3232   USE cpl_oasis3     ! OASIS3 coupling 
    3333   USE geo2ocean      !  
    34    USE oce     , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
     34   USE oce     , ONLY : ts, uu, vv, sshn, sshb, fraqsr_1lev 
    3535   USE ocealb         !  
    3636   USE eosbn2         !  
    … …  
    10491049 
    10501050 
    1051    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )      
     1051   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )      
    10521052      !!---------------------------------------------------------------------- 
    10531053      !!             ***  ROUTINE sbc_cpl_rcv  *** 
    … …  
    10991099      INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
    11001100      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     1101      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices 
    11011102      !! 
    11021103      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    … …  
    13021303         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 
    13031304                                      .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN 
    1304             CALL sbc_stokes() 
     1305            CALL sbc_stokes( Kmm ) 
    13051306         ENDIF 
    13061307      ENDIF 
    … …  
    13541355      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
    13551356         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
    1356          ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau 
    1357          un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
     1357         uu(:,:,1,Kbb) = ssu_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau 
     1358         uu(:,:,1,Kmm) = ssu_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling 
    13581359         CALL iom_put( 'ssu_m', ssu_m ) 
    13591360      ENDIF 
    13601361      IF( srcv(jpr_ocy1)%laction ) THEN 
    13611362         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
    1362          vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau 
    1363          vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
     1363         vv(:,:,1,Kbb) = ssv_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau 
     1364         vv(:,:,1,Kmm) = ssv_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling 
    13641365         CALL iom_put( 'ssv_m', ssv_m ) 
    13651366      ENDIF 
    … …  
    20362037    
    20372038    
    2038    SUBROUTINE sbc_cpl_snd( kt ) 
     2039   SUBROUTINE sbc_cpl_snd( kt, Kmm ) 
    20392040      !!---------------------------------------------------------------------- 
    20402041      !!             ***  ROUTINE sbc_cpl_snd  *** 
    … …  
    20462047      !!---------------------------------------------------------------------- 
    20472048      INTEGER, INTENT(in) ::   kt 
     2049      INTEGER, INTENT(in) ::   Kmm    ! ocean model time level index 
    20482050      ! 
    20492051      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    … …  
    20632065          
    20642066         IF ( nn_components == jp_iam_opa ) THEN 
    2065             ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
     2067            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    20662068         ELSE 
    20672069            ! we must send the surface potential temperature  
    2068             IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    2069             ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     2070            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
     2071            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 
    20702072            ENDIF 
    20712073            ! 
    … …  
    20952097               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    20962098               END SELECT 
    2097             CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0   
     2099            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0   
    20982100               SELECT CASE( sn_snd_temp%clcat )  
    20992101               CASE( 'yes' )     
    … …  
    23162318         !                                                               i      i+1 (for I) 
    23172319         IF( nn_components == jp_iam_opa ) THEN 
    2318             zotx1(:,:) = un(:,:,1)   
    2319             zoty1(:,:) = vn(:,:,1)   
     2320            zotx1(:,:) = uu(:,:,1,Kmm)   
     2321            zoty1(:,:) = vv(:,:,1,Kmm)   
    23202322         ELSE         
    23212323            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    … …  
    23232325               DO jj = 2, jpjm1 
    23242326                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    2325                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    2326                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2327                     zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
     2328                     zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) )  
    23272329                  END DO 
    23282330               END DO 
    … …  
    23302332               DO jj = 2, jpjm1 
    23312333                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    2332                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    2333                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    2334                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    2335                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     2334                     zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
     2335                     zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
     2336                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )    ) *  fr_i(ji,jj) 
     2337                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )    ) *  fr_i(ji,jj) 
    23362338                  END DO 
    23372339               END DO 
    … …  
    23402342               DO jj = 2, jpjm1 
    23412343                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    2342                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    2343                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    2344                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    2345                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     2344                     zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
     2345                        &         + 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )    ) *  fr_i(ji,jj) 
     2346                     zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
     2347                        &         + 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )    ) *  fr_i(ji,jj) 
    23462348                  END DO 
    23472349               END DO 
    … …  
    24062408             DO jj = 2, jpjm1  
    24072409                DO ji = fs_2, fs_jpim1   ! vector opt.  
    2408                    zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )  
    2409                    zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )   
     2410                   zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )  
     2411                   zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )   
    24102412                END DO  
    24112413             END DO  
    … …  
    24132415             DO jj = 2, jpjm1  
    24142416                DO ji = fs_2, fs_jpim1   ! vector opt.  
    2415                    zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)    
    2416                    zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)  
     2417                   zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)    
     2418                   zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)  
    24172419                   zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    24182420                   zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
    … …  
    24232425             DO jj = 2, jpjm1  
    24242426                DO ji = fs_2, fs_jpim1   ! vector opt.  
    2425                    zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &  
     2427                   zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &  
    24262428                      &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    2427                    zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     2429                   zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &  
    24282430                      &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
    24292431                END DO 
    … …  
    24972499      !                                                        ! SSS 
    24982500      IF( ssnd(jps_soce  )%laction )  THEN 
    2499          CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     2501         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 
    25002502      ENDIF 
    25012503      !                                                        ! first T level thickness  
    25022504      IF( ssnd(jps_e3t1st )%laction )  THEN 
    2503          CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2505         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info ) 
    25042506      ENDIF 
    25052507      !                                                        ! Qsr fraction 
    … …  
    25242526      !                                                      ! ------------------------- ! 
    25252527      ! needed by Met Office 
    2526       CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz) 
     2528      CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) 
    25272529      ztmp1(:,:) = sstfrz(:,:) + rt0 
    25282530      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) 

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

    r10425 r10922  
    169169      ! Values from a CICE restart file would overwrite this 
    170170      IF ( .NOT. ln_rstart ) THEN     
    171          CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
     171         CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.)  
    172172      ENDIF   
    173173#endif 
    … …  
    194194! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 
    195195      IF( .NOT. ln_rstart ) THEN 
    196          tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 
    197          tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
     196         ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz) 
     197         ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm) 
    198198      ENDIF 
    199199 
    … …  
    235235               ! 
    236236               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    237                   e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    238                   e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     237                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     238                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    239239               ENDDO 
    240                e3t_a(:,:,:) = e3t_b(:,:,:) 
     240               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 
    241241               ! Reconstruction of all vertical scale factors at now and before time-steps 
    242242               ! ============================================================================= 
    243243               ! Horizontal scale factor interpolations 
    244244               ! -------------------------------------- 
    245                CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    246                CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
    247                CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    248                CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    249                CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
     245               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
     246               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
     247               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
     248               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
     249               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    250250               ! Vertical scale factor interpolations 
    251251               ! ------------------------------------ 
    252                CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    253                CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    254                CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    255                CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
    256                CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     252               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
     253               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
     254               CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
     255               CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
     256               CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    257257               ! t- and w- points depth 
    258258               ! ---------------------- 
    259                gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    260                gdepw_n(:,:,1) = 0.0_wp 
    261                gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
     259               gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
     260               gdepw(:,:,1,Kmm) = 0.0_wp 
     261               gde3w(:,:,1)     = gdept(:,:,1,Kmm) - sshn(:,:) 
    262262               DO jk = 2, jpk 
    263                   gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
    264                   gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
    265                   gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
     263                  gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 
     264                  gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
     265                  gde3w(:,:,jk)     = gdept(:,:,jk  ,Kmm) - sshn   (:,:) 
    266266               END DO 
    267267            ENDIF 

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

    r10068 r10922  
    4242CONTAINS 
    4343 
    44    SUBROUTINE sbc_ice_if( kt ) 
     44   SUBROUTINE sbc_ice_if( kt, Kbb, Kmm ) 
    4545      !!--------------------------------------------------------------------- 
    4646      !!                     ***  ROUTINE sbc_ice_if  *** 
    … …  
    5959      !!--------------------------------------------------------------------- 
    6060      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     61      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    6162      ! 
    6263      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    118119               ENDIF 
    119120 
    120                tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature 
     121               ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp )     ! avoid over-freezing point temperature 
    121122 
    122123               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover 
    … …  
    125126               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0) 
    126127               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1) 
    127                zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) ) 
    128                zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp ) 
     128               zqri = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - ( zt_fzp - 1.) ) 
     129               zqrj = ztrp * MIN( 0., ts(ji,jj,1,jp_tem,Kbb) - zt_fzp ) 
    129130               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    & 
    130131                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1) 

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

    r10536 r10922  
    7575CONTAINS 
    7676  
    77   SUBROUTINE sbc_isf( kt ) 
     77  SUBROUTINE sbc_isf( kt, Kmm ) 
    7878      !!--------------------------------------------------------------------- 
    7979      !!                  ***  ROUTINE sbc_isf  *** 
    … …  
    8989      !!---------------------------------------------------------------------- 
    9090      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     91      INTEGER, INTENT(in) ::   Kmm  ! ocean time level indices 
    9192      ! 
    9293      INTEGER ::   ji, jj, jk   ! loop index 
    … …  
    102103         CASE ( 1 )    ! realistic ice shelf formulation 
    103104            ! compute T/S/U/V for the top boundary layer 
    104             CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T') 
    105             CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T') 
    106             CALL sbc_isf_tbl(un(:,:,:)        ,utbl(:,:),'U') 
    107             CALL sbc_isf_tbl(vn(:,:,:)        ,vtbl(:,:),'V') 
     105            CALL sbc_isf_tbl(ts(:,:,:,jp_tem,Kmm),ttbl(:,:),'T',Kmm) 
     106            CALL sbc_isf_tbl(ts(:,:,:,jp_sal,Kmm),stbl(:,:),'T',Kmm) 
     107            CALL sbc_isf_tbl(uu(:,:,:,Kmm)       ,utbl(:,:),'U',Kmm) 
     108            CALL sbc_isf_tbl(vv(:,:,:,Kmm)       ,vtbl(:,:),'V',Kmm) 
    108109            ! iom print 
    109110            CALL iom_put('ttbl',ttbl(:,:)) 
    … …  
    113114            ! compute fwf and heat flux 
    114115            ! compute fwf and heat flux 
    115             IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt) 
     116            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt, Kmm) 
    116117            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * rLfusisf  ! heat        flux 
    117118            ENDIF 
    … …  
    119120         CASE ( 2 )    ! Beckmann and Goosse parametrisation  
    120121            stbl(:,:)   = soce 
    121             CALL sbc_isf_bg03(kt) 
     122            CALL sbc_isf_bg03(kt, Kmm) 
    122123            ! 
    123124         CASE ( 3 )    ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
    … …  
    179180                  ikb = misfkb(ji,jj) 
    180181                  DO jk = ikt, ikb - 1 
    181                      zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 
    182                      zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 
    183                      zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk) 
     182                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm) 
     183                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm) 
     184                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm) 
    184185                  END DO 
    185186                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj)   &  
    186                      &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk) 
     187                     &                                                                   * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm) 
    187188                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj)   &  
    188                      &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk) 
     189                     &                                                                   * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm) 
    189190                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj)   &   
    190                      &                                                                   * ralpha(ji,jj) * e3t_n(ji,jj,jk) 
     191                     &                                                                   * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm) 
    191192               END DO 
    192193            END DO 
    … …  
    251252 
    252253 
    253   SUBROUTINE sbc_isf_init 
     254  SUBROUTINE sbc_isf_init( Kmm ) 
    254255      !!--------------------------------------------------------------------- 
    255256      !!                  ***  ROUTINE sbc_isf_init  *** 
    … …  
    263264      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf 
    264265      !!---------------------------------------------------------------------- 
     266      INTEGER, INTENT(in) ::   Kmm  ! ocean time level indices 
    265267      INTEGER               :: ji, jj, jk           ! loop index 
    266268      INTEGER               :: ik                   ! current level index 
    … …  
    355357                ik = 2 
    356358!!gm potential bug: use gdepw_0 not _n 
    357                 DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO 
     359                DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw(ji,jj,ik,Kmm) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO 
    358360                misfkt(ji,jj) = ik-1 
    359361            END DO 
    … …  
    386388            ikb = misfkt(ji,jj) 
    387389            ! thickness of boundary layer at least the top level thickness 
    388             rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 
     390            rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t(ji,jj,ikt,Kmm)) 
    389391 
    390392            ! determine the deepest level influenced by the boundary layer 
    391393            DO jk = ikt+1, mbkt(ji,jj) 
    392                IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) )   ikb = jk 
    393             END DO 
    394             rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. 
     394               IF( (SUM(e3t(ji,jj,ikt:jk-1,Kmm)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) )   ikb = jk 
     395            END DO 
     396            rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t(ji,jj,ikt:ikb,Kmm))) ! limit the tbl to water thickness. 
    395397            misfkb(ji,jj) = ikb                                                   ! last wet level of the tbl 
    396398            r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    397399 
    398             zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1 
    399             ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     400            zhk           = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1 
     401            ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t(ji,jj,ikb,Kmm)  ! proportion of bottom cell influenced by boundary layer 
    400402         END DO 
    401403      END DO 
    … …  
    411413 
    412414 
    413   SUBROUTINE sbc_isf_bg03(kt) 
     415  SUBROUTINE sbc_isf_bg03( kt, Kmm ) 
    414416      !!--------------------------------------------------------------------- 
    415417      !!                  ***  ROUTINE sbc_isf_bg03  *** 
    … …  
    426428      !!---------------------------------------------------------------------- 
    427429      INTEGER, INTENT ( in ) :: kt 
     430      INTEGER, INTENT ( in ) :: Kmm  ! ocean time level indices 
    428431      ! 
    429432      INTEGER  :: ji, jj, jk ! dummy loop index 
    … …  
    444447               DO jk = misfkt(ji,jj),misfkb(ji,jj) 
    445448                  ! Calculate freezing temperature 
    446                   zpress = grav*rau0*gdept_n(ji,jj,ik)*1.e-04 
     449                  zpress = grav*rau0*gdept(ji,jj,ik,Kmm)*1.e-04 
    447450                  CALL eos_fzp(stbl(ji,jj), zt_frz, zpress)  
    448                   zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-zt_frz) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! sum temp 
     451                  zt_sum = zt_sum + (ts(ji,jj,jk,jp_tem,Kmm)-zt_frz) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)  ! sum temp 
    449452               END DO 
    450453               zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value 
    … …  
    466469 
    467470 
    468   SUBROUTINE sbc_isf_cav( kt ) 
     471  SUBROUTINE sbc_isf_cav( kt, Kmm ) 
    469472      !!--------------------------------------------------------------------- 
    470473      !!                     ***  ROUTINE sbc_isf_cav  *** 
    … …  
    480483      !!--------------------------------------------------------------------- 
    481484      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     485      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    482486      ! 
    483487      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    520524 
    521525            ! compute gammat every where (2d) 
    522             CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx) 
     526            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, Kmm) 
    523527             
    524528            ! compute upward heat flux zhtflx and upward water flux zwflx 
    … …  
    536540         CASE ( 2 )  ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015) 
    537541            ! compute gammat every where (2d) 
    538             CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx) 
     542            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, Kmm) 
    539543 
    540544            ! compute upward heat flux zhtflx and upward water flux zwflx 
    … …  
    600604 
    601605 
    602    SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf ) 
     606   SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf, Kmm ) 
    603607      !!---------------------------------------------------------------------- 
    604608      !! ** Purpose    : compute the coefficient echange for heat flux 
    … …  
    611615      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pgt   , pgs      !  
    612616      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pqhisf, pqwisf   !  
     617      INTEGER                 , INTENT(in   ) ::   Kmm  ! ocean time level indices 
    613618      ! 
    614619      INTEGER  :: ji, jj                     ! loop index 
    … …  
    679684!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation 
    680685!!gm moreover, use Max(rn2,0) to take care of static instabilities.... 
    681                   zcoef = 0.5_wp / e3w_n(ji,jj,ikt+1) 
     686                  zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm) 
    682687                  !                                            ! shear of horizontal velocity 
    683                   zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )  & 
    684                      &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  ) 
    685                   zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )  & 
    686                      &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  ) 
     688                  zdku = zcoef * (  uu(ji-1,jj  ,ikt  ,Kmm) + uu(ji,jj,ikt  ,Kmm)  & 
     689                     &             -uu(ji-1,jj  ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm)  ) 
     690                  zdkv = zcoef * (  vv(ji  ,jj-1,ikt  ,Kmm) + vv(ji,jj,ikt  ,Kmm)  & 
     691                     &             -vv(ji  ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm)  ) 
    687692                  !                                            ! richardson number (minimum value set to zero) 
    688693                  zRc = rn2(ji,jj,ikt+1) / MAX( zdku*zdku + zdkv*zdkv, zeps ) 
    … …  
    691696                  zts(jp_tem) = ttbl(ji,jj) 
    692697                  zts(jp_sal) = stbl(ji,jj) 
    693                   zdep        = gdepw_n(ji,jj,ikt) 
     698                  zdep        = gdepw(ji,jj,ikt,Kmm) 
    694699                  ! 
    695700                  CALL eos_rab( zts, zdep, zab ) 
    … …  
    700705                  !! compute Monin Obukov Length 
    701706                  ! Maximum boundary layer depth 
    702                   zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001_wp 
     707                  zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp 
    703708                  ! Compute Monin obukhov length scale at the surface and Ekman depth: 
    704709                  zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps)) 
    … …  
    727732 
    728733 
    729    SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin ) 
     734   SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin, Kmm ) 
    730735      !!---------------------------------------------------------------------- 
    731736      !!                  ***  SUBROUTINE sbc_isf_tbl  *** 
    … …  
    737742      REAL(wp), DIMENSION(:,:)  , INTENT(  out) :: pvarout 
    738743      CHARACTER(len=1),           INTENT(in   ) :: cd_ptin ! point of variable in/out 
     744      INTEGER                   , INTENT(in   ) :: Kmm  ! ocean time level indices 
    739745      ! 
    740746      INTEGER ::   ji, jj, jk                ! loop index 
    … …  
    753759               ikt = miku(ji,jj) ; ikb = miku(ji,jj) 
    754760               ! thickness of boundary layer at least the top level thickness 
    755                zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u_n(ji,jj,ikt) ) 
     761               zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u(ji,jj,ikt,Kmm) ) 
    756762 
    757763               ! determine the deepest level influenced by the boundary layer 
    758764               DO jk = ikt+1, mbku(ji,jj) 
    759                   IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
    760                END DO 
    761                zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     765                  IF ( (SUM(e3u(ji,jj,ikt:jk-1,Kmm)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
     766               END DO 
     767               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u(ji,jj,ikt:ikb,Kmm)))  ! limit the tbl to water thickness. 
    762768 
    763769               ! level fully include in the ice shelf boundary layer 
    764770               DO jk = ikt, ikb - 1 
    765                   ze3 = e3u_n(ji,jj,jk) 
     771                  ze3 = e3u(ji,jj,jk,Kmm) 
    766772                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3 
    767773               END DO 
    768774 
    769775               ! level partially include in ice shelf boundary layer  
    770                zhk = SUM( e3u_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj) 
     776               zhk = SUM( e3u(ji, jj, ikt:ikb - 1,Kmm)) / zhisf_tbl(ji,jj) 
    771777               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk) 
    772778            END DO 
    … …  
    785791               ikt = mikv(ji,jj) ; ikb = mikv(ji,jj) 
    786792               ! thickness of boundary layer at least the top level thickness 
    787                zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v_n(ji,jj,ikt)) 
     793               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v(ji,jj,ikt,Kmm)) 
    788794 
    789795               ! determine the deepest level influenced by the boundary layer 
    790796               DO jk = ikt+1, mbkv(ji,jj) 
    791                   IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
    792                END DO 
    793                zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     797                  IF ( (SUM(e3v(ji,jj,ikt:jk-1,Kmm)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
     798               END DO 
     799               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v(ji,jj,ikt:ikb,Kmm)))  ! limit the tbl to water thickness. 
    794800 
    795801               ! level fully include in the ice shelf boundary layer 
    796802               DO jk = ikt, ikb - 1 
    797                   ze3 = e3v_n(ji,jj,jk) 
     803                  ze3 = e3v(ji,jj,jk,Kmm) 
    798804                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3 
    799805               END DO 
    800806 
    801807               ! level partially include in ice shelf boundary layer  
    802                zhk = SUM( e3v_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj) 
     808               zhk = SUM( e3v(ji, jj, ikt:ikb - 1,Kmm)) / zhisf_tbl(ji,jj) 
    803809               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk) 
    804810            END DO 
    … …  
    820826               ! level fully include in the ice shelf boundary layer 
    821827               DO jk = ikt, ikb - 1 
    822                   ze3 = e3t_n(ji,jj,jk) 
     828                  ze3 = e3t(ji,jj,jk,Kmm) 
    823829                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3 
    824830               END DO 
    825831 
    826832               ! level partially include in ice shelf boundary layer  
    827                zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 
     833               zhk = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj) 
    828834               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk) 
    829835            END DO 
    … …  
    837843       
    838844 
    839    SUBROUTINE sbc_isf_div( phdivn ) 
     845   SUBROUTINE sbc_isf_div( phdivn, Kmm ) 
    840846      !!---------------------------------------------------------------------- 
    841847      !!                  ***  SUBROUTINE sbc_isf_div  *** 
    … …  
    850856      !!---------------------------------------------------------------------- 
    851857      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdivn   ! horizontal divergence 
     858      INTEGER                   , INTENT( in    ) ::   Kmm      ! ocean time level indices 
    852859      !  
    853860      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    865872               ikb = misfkt(ji,jj) 
    866873               ! thickness of boundary layer at least the top level thickness 
    867                rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 
     874               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t(ji,jj,ikt,Kmm)) 
    868875 
    869876               ! determine the deepest level influenced by the boundary layer 
    870877               DO jk = ikt, mbkt(ji,jj) 
    871                   IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    872                END DO 
    873                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     878                  IF ( (SUM(e3t(ji,jj,ikt:jk-1,Kmm)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     879               END DO 
     880               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t(ji,jj,ikt:ikb,Kmm)))  ! limit the tbl to water thickness. 
    874881               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
    875882               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    876883 
    877                zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
    878                ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     884               zhk           = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
     885               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t(ji,jj,ikb,Kmm)  ! proportion of bottom cell influenced by boundary layer 
    879886            END DO 
    880887         END DO 

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

    r10499 r10922  
    7676CONTAINS 
    7777 
    78    SUBROUTINE sbc_init 
     78   SUBROUTINE sbc_init( Kbb, Kmm ) 
    7979      !!--------------------------------------------------------------------- 
    8080      !!                    ***  ROUTINE sbc_init *** 
    … …  
    8888      !!              - nsbc: type of sbc 
    8989      !!---------------------------------------------------------------------- 
     90      INTEGER, INTENT(in) ::   Kbb, Kmm              ! ocean time level indices 
    9091      INTEGER ::   ios, icpt                         ! local integer 
    9192      LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical 
    … …  
    323324      !                       !**  associated modules : initialization 
    324325      ! 
    325                           CALL sbc_ssm_init           ! Sea-surface mean fields initialization 
    326       ! 
    327       IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization 
    328  
    329       IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization 
    330       ! 
    331       IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves 
    332       ! 
    333                           CALL sbc_rnf_init            ! Runof initialization 
    334       ! 
    335       IF( ln_apr_dyn )    CALL sbc_apr_init            ! Atmo Pressure Forcing initialization 
     326                          CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization 
     327      ! 
     328      IF( ln_blk      )   CALL sbc_blk_init              ! bulk formulae initialization 
     329 
     330      IF( ln_ssr      )   CALL sbc_ssr_init              ! Sea-Surface Restoring initialization 
     331      ! 
     332      IF( ln_isf      )   CALL sbc_isf_init( Kmm )       ! Compute iceshelves 
     333      ! 
     334                          CALL sbc_rnf_init( Kmm )       ! Runof initialization 
     335      ! 
     336      IF( ln_apr_dyn )    CALL sbc_apr_init              ! Atmo Pressure Forcing initialization 
    336337      ! 
    337338#if defined key_si3 
    … …  
    359360 
    360361 
    361    SUBROUTINE sbc( kt ) 
     362   SUBROUTINE sbc( kt, Kbb, Kmm ) 
    362363      !!--------------------------------------------------------------------- 
    363364      !!                    ***  ROUTINE sbc  *** 
    … …  
    376377      !!---------------------------------------------------------------------- 
    377378      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     379      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    378380      ! 
    379381      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    … …  
    411413      ll_opa = nn_components == jp_iam_opa 
    412414      ! 
    413       IF( .NOT.ll_sas )   CALL sbc_ssm ( kt )            ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    414       IF( ln_wave     )   CALL sbc_wave( kt )            ! surface waves 
     415      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     416      IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves 
    415417 
    416418      ! 
    … …  
    419421      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    420422      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    421       CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt )                    ! user defined formulation  
    422       CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                    ! flux formulation 
     423      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt )                             ! user defined formulation  
     424      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation 
    423425      CASE( jp_blk     ) 
    424          IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 
    425                                CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean 
     426         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: SAS receiving fields from OPA 
     427                               CALL sbc_blk       ( kt )                             ! bulk formulation for the ocean 
    426428                               ! 
    427       CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     429      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! pure coupled formulation 
    428430      CASE( jp_none    ) 
    429          IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
     431         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS 
    430432      END SELECT 
    431433      ! 
    432       IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
    433       ! 
    434       IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves  
     434      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing 
     435      ! 
     436      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves  
    435437      ! 
    436438      !                                            !==  Misc. Options  ==! 
    437439      ! 
    438440      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas 
    439       CASE(  1 )   ;         CALL sbc_ice_if   ( kt )             ! Ice-cover climatology ("Ice-if" model) 
     441      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model) 
    440442#if defined key_si3 
    441443      CASE(  2 )   ;         CALL ice_stp  ( kt, nsbc )           ! SI3 ice model 
    … …  
    451453      ENDIF 
    452454 
    453       IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves 
     455      IF( ln_isf         )   CALL sbc_isf( kt, Kmm )              ! compute iceshelves 
    454456 
    455457      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 

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

    r10523 r10922  
    173173 
    174174 
    175    SUBROUTINE sbc_rnf_div( phdivn ) 
     175   SUBROUTINE sbc_rnf_div( phdivn, Kmm ) 
    176176      !!---------------------------------------------------------------------- 
    177177      !!                  ***  ROUTINE sbc_rnf  *** 
    … …  
    185185      !! ** Action  :   phdivn   decreased by the runoff inflow 
    186186      !!---------------------------------------------------------------------- 
     187      INTEGER                   , INTENT(in   ) ::   Kmm      ! ocean time level index 
    187188      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    188189      !! 
    … …  
    207208                  h_rnf(ji,jj) = 0._wp 
    208209                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 
    209                      h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box 
     210                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)   ! to the bottom of the relevant grid box 
    210211                  END DO 
    211212                  !                          ! apply the runoff input flow 
    … …  
    217218         ENDIF 
    218219      ELSE                       !==   runoff put only at the surface   ==! 
    219          h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box 
    220          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
     220         h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box 
     221         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t(:,:,1,Kmm) 
    221222      ENDIF 
    222223      ! 
    … …  
    224225 
    225226 
    226    SUBROUTINE sbc_rnf_init 
     227   SUBROUTINE sbc_rnf_init( Kmm ) 
    227228      !!---------------------------------------------------------------------- 
    228229      !!                  ***  ROUTINE sbc_rnf_init  *** 
    … …  
    234235      !! ** Action  : - read parameters 
    235236      !!---------------------------------------------------------------------- 
     237      INTEGER, INTENT(in) :: Kmm           ! ocean time level index 
    236238      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    237239      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices 
    … …  
    356358               h_rnf(ji,jj) = 0._wp 
    357359               DO jk = 1, nk_rnf(ji,jj) 
    358                   h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 
     360                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) 
    359361               END DO 
    360362            END DO 
    … …  
    411413               h_rnf(ji,jj) = 0._wp 
    412414               DO jk = 1, nk_rnf(ji,jj) 
    413                   h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 
     415                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) 
    414416               END DO 
    415417            END DO 
    … …  
    424426      ELSE                                       ! runoffs applied at the surface 
    425427         nk_rnf(:,:) = 1 
    426          h_rnf (:,:) = e3t_n(:,:,1) 
     428         h_rnf (:,:) = e3t(:,:,1,Kmm) 
    427429      ENDIF 
    428430      ! 

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

    r10425 r10922  
    3939CONTAINS 
    4040 
    41    SUBROUTINE sbc_ssm( kt ) 
     41   SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 
    4242      !!--------------------------------------------------------------------- 
    4343      !!                     ***  ROUTINE sbc_oce  *** 
    … …  
    5353      !!--------------------------------------------------------------------- 
    5454      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     55      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    5556      ! 
    5657      INTEGER  ::   ji, jj               ! loop index 
    … …  
    6263      DO jj = 1, jpj 
    6364         DO ji = 1, jpi 
    64             zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
    65             zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
     65            zts(ji,jj,jp_tem) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) 
     66            zts(ji,jj,jp_sal) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) 
    6667         END DO 
    6768      END DO 
    … …  
    6970      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    7071         !                                                ! ---------------------------------------- ! 
    71          ssu_m(:,:) = ub(:,:,1) 
    72          ssv_m(:,:) = vb(:,:,1) 
     72         ssu_m(:,:) = uu(:,:,1,Kbb) 
     73         ssv_m(:,:) = vv(:,:,1,Kbb) 
    7374         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    7475         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    … …  
    8081         ENDIF 
    8182         ! 
    82          e3t_m(:,:) = e3t_n(:,:,1) 
     83         e3t_m(:,:) = e3t(:,:,1,Kmm) 
    8384         ! 
    8485         frq_m(:,:) = fraqsr_1lev(:,:) 
    … …  
    9293            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    9394            zcoef = REAL( nn_fsbc - 1, wp ) 
    94             ssu_m(:,:) = zcoef * ub(:,:,1) 
    95             ssv_m(:,:) = zcoef * vb(:,:,1) 
     95            ssu_m(:,:) = zcoef * uu(:,:,1,Kbb) 
     96            ssv_m(:,:) = zcoef * vv(:,:,1,Kbb) 
    9697            IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    9798            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
    … …  
    103104            ENDIF 
    104105            ! 
    105             e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
     106            e3t_m(:,:) = zcoef * e3t(:,:,1,Kmm) 
    106107            ! 
    107108            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    … …  
    120121         !                                                !        Cumulate at each time step        ! 
    121122         !                                                ! ---------------------------------------- ! 
    122          ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    123          ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
     123         ssu_m(:,:) = ssu_m(:,:) + uu(:,:,1,Kbb) 
     124         ssv_m(:,:) = ssv_m(:,:) + vv(:,:,1,Kbb) 
    124125         IF( l_useCT )  THEN     ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    125126         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    … …  
    131132         ENDIF 
    132133         ! 
    133          e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
     134         e3t_m(:,:) = e3t_m(:,:) + e3t(:,:,1,Kmm) 
    134135         ! 
    135136         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
    … …  
    184185 
    185186 
    186    SUBROUTINE sbc_ssm_init 
     187   SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 
    187188      !!---------------------------------------------------------------------- 
    188189      !!                  ***  ROUTINE sbc_ssm_init  *** 
    … …  
    192193      !! ** Action  : - read parameters 
    193194      !!---------------------------------------------------------------------- 
     195      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    194196      REAL(wp) ::   zcoef, zf_sbc   ! local scalar 
    195197      !!---------------------------------------------------------------------- 
    … …  
    242244         ! 
    243245         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
    244          ssu_m(:,:) = ub(:,:,1) 
    245          ssv_m(:,:) = vb(:,:,1) 
    246          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    247          ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    248          ENDIF 
    249          sss_m(:,:) = tsn  (:,:,1,jp_sal) 
    250          ssh_m(:,:) = sshn (:,:) 
    251          e3t_m(:,:) = e3t_n(:,:,1) 
     246         ssu_m(:,:) = uu(:,:,1,Kbb) 
     247         ssv_m(:,:) = vv(:,:,1,Kbb) 
     248         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
     249         ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem,Kmm) 
     250         ENDIF 
     251         sss_m(:,:) = ts  (:,:,1,jp_sal,Kmm) 
     252         ssh_m(:,:) = sshn(:,:) 
     253         e3t_m(:,:) = e3t (:,:,1,Kmm) 
    252254         frq_m(:,:) = 1._wp 
    253255         ! 

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

    r10425 r10922  
    8080CONTAINS 
    8181 
    82    SUBROUTINE sbc_stokes( ) 
     82   SUBROUTINE sbc_stokes( Kmm ) 
    8383      !!--------------------------------------------------------------------- 
    8484      !!                     ***  ROUTINE sbc_stokes  *** 
    … …  
    9292      !! ** action   
    9393      !!--------------------------------------------------------------------- 
     94      INTEGER, INTENT(in) :: Kmm ! ocean time level index 
    9495      INTEGER  ::   jj, ji, jk   ! dummy loop argument 
    9596      INTEGER  ::   ik           ! local integer  
    … …  
    152153            DO jj = 2, jpjm1 
    153154               DO ji = 2, jpim1 
    154                   zdep_u = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) ) 
    155                   zdep_v = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) ) 
     155                  zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 
     156                  zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) 
    156157                  !                           
    157158                  zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth 
    … …  
    179180            DO jj = 2, jpjm1 
    180181               DO ji = 2, jpim1 
    181                   zbot_u = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji+1,jj,jk+1) )  ! 2 * bottom depth 
    182                   zbot_v = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji,jj+1,jk+1) )  ! 2 * bottom depth 
     182                  zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) )  ! 2 * bottom depth 
     183                  zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) )  ! 2 * bottom depth 
    183184                  zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth 
    184185                  zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth 
    185186                  ! 
    186                   zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u_n(ji,jj,jk))     ! 2k * thickness 
    187                   zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v_n(ji,jj,jk))     ! 2k * thickness 
     187                  zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm))     ! 2k * thickness 
     188                  zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm))     ! 2k * thickness 
    188189 
    189190                  ! Depth attenuation .... do u component first.. 
    … …  
    223224         DO jj = 2, jpj 
    224225            DO ji = fs_2, jpi 
    225                ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd(ji  ,jj,jk)    & 
    226                   &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd(ji-1,jj,jk)    & 
    227                   &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd(ji,jj  ,jk)    & 
    228                   &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj) 
     226               ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * usd(ji  ,jj,jk)    & 
     227                  &                 - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk)    & 
     228                  &                 + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vsd(ji,jj  ,jk)    & 
     229                  &                 - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj) 
    229230            END DO 
    230231         END DO 
    … …  
    307308 
    308309 
    309    SUBROUTINE sbc_wave( kt ) 
     310   SUBROUTINE sbc_wave( kt, Kmm ) 
    310311      !!--------------------------------------------------------------------- 
    311312      !!                     ***  ROUTINE sbc_wave  *** 
    … …  
    322323      !!--------------------------------------------------------------------- 
    323324      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
     325      INTEGER, INTENT(in   ) ::   Kmm  ! ocean time index 
    324326      !!--------------------------------------------------------------------- 
    325327      ! 
    … …  
    361363         ! 
    362364         IF( ( ll_st_bv_li   .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. & 
    363            & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes() 
     365           & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes( Kmm ) 
    364366         ! 
    365367      ENDIF 

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

    r10880 r10922  
    127127      ! 
    128128      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
    129          &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA' )   ! add the eiv transport (if necessary) 
     129         &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm )   ! add the eiv transport (if necessary) 
    130130      ! 
    131131      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA' )   ! add the mle transport (if necessary) 

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

    r10874 r10922  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_ldf( kt ) 
     49   SUBROUTINE tra_ldf( kt, Kmm ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5454      !!---------------------------------------------------------------------- 
    5555      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     56      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level indices 
    5657      !! 
    5758      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    7273         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
    7374      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    74          CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
     75         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1, Kmm   ) 
    7576      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    76          CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf_tra ) 
     77         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf_tra, Kmm ) 
    7778      END SELECT 
    7879      ! 

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

    r10874 r10922  
    161161   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    162162      &                                                    pgui, pgvi,   & 
    163       &                                                    ptb , pta , kjpt, kldf ) 
     163      &                                                    ptb , pta , kjpt, kldf, Kmm ) 
    164164      !!---------------------------------------------------------------------- 
    165165      !!                 ***  ROUTINE tra_ldf_blp  *** 
    … …  
    179179      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    180180      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used 
     181      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level indices 
    181182      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    182183      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    … …  
    210211         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
    211212      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    212          CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
     213         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1, Kmm ) 
    213214      END SELECT 
    214215      ! 
    … …  
    226227         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
    227228      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    228          CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
     229         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2, Kmm ) 
    229230      END SELECT 
    230231      ! 

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

    r10874 r10922  
    5050  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    5151      &                                                     pgui, pgvi,   & 
    52       &                                         ptb , ptbb, pta , kjpt, kpass ) 
     52      &                                         ptb , ptbb, pta , kjpt, kpass, Kmm ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_ldf_triad  *** 
    … …  
    7575      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    7676      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     77      INTEGER                              , INTENT(in)    ::   Kmm        ! ocean time level indices 
    7778      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    7879      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
    … …  
    213214         ENDIF 
    214215         ! 
    215          IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
     216         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    216217         ! 
    217218      ENDIF                                  !==  end 1st pass only  ==! 

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

    r10905 r10922  
    428428      !                             
    429429      IF( ln_diurnal_only ) THEN                   ! diurnal only: a subset of the initialisation routines 
    430          CALL  istate_init                            ! ocean initial state (Dynamics and tracers) 
    431          CALL     sbc_init                            ! Forcings : surface module 
     430         CALL  istate_init( Nbb, Nnn )                ! ocean initial state (Dynamics and tracers) 
     431         CALL     sbc_init( Nbb, Nnn )                ! Forcings : surface module 
    432432         CALL tra_qsr_init                            ! penetrative solar radiation qsr 
    433433         IF( ln_diaobs ) THEN                         ! Observation & model comparison 
    434             CALL dia_obs_init                            ! Initialize observational data 
    435             CALL dia_obs( nit000 - 1 )                   ! Observation operator for restart 
     434            CALL dia_obs_init( Nnn )                     ! Initialize observational data 
     435            CALL dia_obs( nit000 - 1, Nnn )              ! Observation operator for restart 
    436436         ENDIF      
    437437         IF( lk_asminc )   CALL asm_inc_init          ! Assimilation increments 
    … …  
    440440      ENDIF 
    441441       
    442                            CALL  istate_init    ! ocean initial state (Dynamics and tracers) 
     442                           CALL  istate_init( Nbb, Nnn ) ! ocean initial state (Dynamics and tracers) 
    443443 
    444444      !                                      ! external forcing  
    445                            CALL    tide_init    ! tidal harmonics 
    446                            CALL     sbc_init    ! surface boundary conditions (including sea-ice) 
    447                            CALL     bdy_init    ! Open boundaries initialisation 
     445                           CALL    tide_init             ! tidal harmonics 
     446                           CALL     sbc_init( Nbb, Nnn ) ! surface boundary conditions (including sea-ice) 
     447                           CALL     bdy_init             ! Open boundaries initialisation 
    448448 
    449449      !                                      ! Ocean physics 
    … …  
    491491                           CALL dia_hsb_init    ! heat content, salt content and volume budgets 
    492492                           CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends 
    493                            CALL dia_obs_init    ! Initialize observational data 
     493                           CALL dia_obs_init( Nnn )        ! Initialize observational data 
    494494                           CALL dia_tmb_init    ! TMB outputs 
    495495                           CALL dia_25h_init    ! 25h mean  outputs 
    496       IF( ln_diaobs    )   CALL dia_obs( nit000-1 )   ! Observation operator for restart 
     496      IF( ln_diaobs    )   CALL dia_obs( nit000-1, Nnn )   ! Observation operator for restart 
    497497 
    498498      !                                      ! Assimilation increments 

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

    r10919 r10922  
    119119      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)  
    120120      IF( ln_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    121                          CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice) 
     121                         CALL sbc     ( kstp, Nbb, Nnn )         ! Sea Boundary Condition (including sea-ice) 
    122122 
    123123      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    152152            &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level 
    153153         IF( ln_traldf_triad ) THEN  
    154                          CALL ldf_slp_triad( kstp )                       ! before slope for triad operator 
     154                         CALL ldf_slp_triad( kstp, Nbb, Nnn )             ! before slope for triad operator 
    155155         ELSE      
    156                          CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator 
     156                         CALL ldf_slp     ( kstp, rhd, rn2b, Nbb, Nnn )   ! before slope for standard operator 
    157157         ENDIF 
    158158      ENDIF 
    159       !                                                                   ! eddy diffusivity coeff. 
    160       IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp )       !       and/or eiv coeff. 
    161       IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp )       ! eddy viscosity coeff.  
     159      !                                                                        ! eddy diffusivity coeff. 
     160      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp, Nbb, Nnn )  !       and/or eiv coeff. 
     161      IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp, Nbb )       ! eddy viscosity coeff.  
    162162 
    163163      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    165165      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    166166 
    167                             CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor) 
     167                            CALL ssh_nxt       ( kstp, Nnn )  ! after ssh (includes call to div_hor) 
    168168      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors  
    169169                            CALL wzv           ( kstp )  ! now cross-level velocity  
    … …  
    202202                                                      ! With split-explicit free surface, since now transports have been updated and ssha as well 
    203203      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
    204                             CALL div_hor    ( kstp )              ! Horizontal divergence  (2nd call in time-split case) 
     204                            CALL div_hor    ( kstp, Nnn )         ! Horizontal divergence  (2nd call in time-split case) 
    205205         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component) 
    206206                            CALL wzv        ( kstp )              ! now cross-level velocity  
    … …  
    256256      IF( lrst_oce .AND. ln_zdfosm ) & 
    257257           &             CALL osm_rst( kstp, Nnn, 'WRITE' )! write OSMOSIS outputs + wn (so must do here) to restarts 
    258                          CALL tra_ldf       ( kstp )  ! lateral mixing 
     258                         CALL tra_ldf       ( kstp, Nnn )  ! lateral mixing 
    259259 
    260260!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    … …  
    293293!!jc: That would be better, but see comment above 
    294294!! 
    295       IF( lrst_oce   )   CALL rst_write    ( kstp )   ! write output ocean restart file 
     295      IF( lrst_oce   )   CALL rst_write    ( kstp, Nbb, Nnn )   ! write output ocean restart file 
    296296      IF( ln_sto_eos )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters 
    297297 
    … …  
    304304                         IF( Agrif_NbStepint() == 0 ) CALL Agrif_update_all( ) ! Update all components 
    305305#endif 
    306       IF( ln_diaobs  )   CALL dia_obs      ( kstp )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     306      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    307307 
    308308      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    321321      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    322322!!gm why lk_oasis and not lk_cpl ???? 
    323       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     323      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges 
    324324      ! 
    325325#if defined key_iomput 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OFF/dtadyn.F90

    r10921 r10922  
    122122      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
    123123      ! 
    124       IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt )    ! Computation of slopes 
     124      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt, Kbb, Kmm )    ! Computation of slopes 
    125125      ! 
    126126      ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature 
    … …  
    679679 
    680680 
    681    SUBROUTINE dta_dyn_slp( kt ) 
     681   SUBROUTINE dta_dyn_slp( kt, Kbb, Kmm ) 
    682682      !!--------------------------------------------------------------------- 
    683683      !!                    ***  ROUTINE dta_dyn_slp  *** 
    … …  
    687687      !!--------------------------------------------------------------------- 
    688688      INTEGER,  INTENT(in) :: kt       ! time step 
     689      INTEGER,  INTENT(in) :: Kbb, Kmm ! ocean time level indices 
    689690      ! 
    690691      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    702703            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
    703704            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
    704             CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     705            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    705706            uslpdta (:,:,:,1) = zuslp (:,:,:)  
    706707            vslpdta (:,:,:,1) = zvslp (:,:,:)  
    … …  
    711712            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    712713            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
    713             CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     714            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    714715            uslpdta (:,:,:,2) = zuslp (:,:,:)  
    715716            vslpdta (:,:,:,2) = zvslp (:,:,:)  
    … …  
    730731              zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    731732              avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
    732               CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     733              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    733734              ! 
    734735              uslpdta (:,:,:,2) = zuslp (:,:,:)  
    … …  
    754755         zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)   ! salinity  
    755756         avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)   ! vertical diffusive coef. 
    756          CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     757         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    757758         ! 
    758759         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 
    … …  
    767768 
    768769 
    769    SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
     770   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj, Kbb, Kmm ) 
    770771      !!--------------------------------------------------------------------- 
    771772      !!                    ***  ROUTINE dta_dyn_slp  *** 
    … …  
    779780      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpi   ! zonal diapycnal slopes 
    780781      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes 
     782      INTEGER ,                              INTENT(in ) :: Kbb, Kmm ! ocean time level indices 
    781783      !!--------------------------------------------------------------------- 
    782784      ! 
    … …  
    796798         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
    797799         CALL zdf_mxl( kt )            ! mixed layer depth 
    798          CALL ldf_slp( kt, rhd, rn2 )  ! slopes 
     800         CALL ldf_slp( kt, rhd, rn2, Kbb, Kmm )  ! slopes 
    799801         puslp (:,:,:) = uslp (:,:,:) 
    800802         pvslp (:,:,:) = vslp (:,:,:) 

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

    r10921 r10922  
    317317                           CALL  istate_init    ! ocean initial state (Dynamics and tracers) 
    318318 
    319                            CALL     sbc_init    ! Forcings : surface module 
     319                           CALL     sbc_init( Nbb, Nnn )    ! Forcings : surface module 
    320320 
    321321      !                                      ! Tracer physics 

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

    r10874 r10922  
    335335      CALL nemo_alloc() 
    336336 
     337      ! Initialise time level indices 
     338      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     339 
     340      ! Initialisation of temporary pointers (to be deleted after development finished) 
     341      CALL update_pointers( Nbb, Nnn, Naa ) 
    337342      !                             !-------------------------------! 
    338343      !                             !  NEMO general initialization  ! 
    … …  
    354359 
    355360      !                                      ! external forcing  
    356                            CALL sbc_init        ! Forcings : surface module  
     361                           CALL sbc_init( Nbb, Nnn )  ! Forcings : surface module  
    357362 
    358363      ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from   

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/SAS/sbcssm.F90

    r10068 r10922  
    6262CONTAINS 
    6363 
    64    SUBROUTINE sbc_ssm( kt ) 
     64   SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 
    6565      !!---------------------------------------------------------------------- 
    6666      !!                  ***  ROUTINE sbc_ssm  *** 
    … …  
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     76                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7577      ! 
    7678      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    156158 
    157159 
    158    SUBROUTINE sbc_ssm_init 
     160   SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 
    159161      !!---------------------------------------------------------------------- 
    160162      !!                  ***  ROUTINE sbc_ssm_init  *** 
    … …  
    162164      !! ** Purpose :   Initialisation of sea surface mean data      
    163165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices  
     167                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    164168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    165169      INTEGER  :: ifpr                               ! dummy loop indice 
    … …  
    311315      ENDIF 
    312316      ! 
    313       CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate 
     317      CALL sbc_ssm( nit000, Kbb, Kmm )   ! need to define ss?_m arrays used in iceistate 
    314318      l_initdone = .TRUE. 
    315319      ! 

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

    r10874 r10922  
    4747 
    4848   PUBLIC   stp   ! called by nemogcm.F90 
     49   PUBLIC   update_pointers ! called by nemo_init 
    4950 
     51   !!---------------------------------------------------------------------- 
     52   !! time level indices 
     53   !!---------------------------------------------------------------------- 
     54   INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs          !! used by nemo_init 
    5055   !!---------------------------------------------------------------------- 
    5156   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    … …  
    98103      IF( ln_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    99104      ! ==> 
    100                              CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
     105                             CALL sbc    ( kstp, Nbb, Nnn )         ! Sea Boundary Condition (including sea-ice) 
    101106 
    102107                             CALL dia_wri( kstp )         ! ocean model: outputs 
    … …  
    128133      ! Coupled mode 
    129134      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    130       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     135      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
    131136 
    132137#if defined key_iomput 
    … …  
    148153   END SUBROUTINE stp 
    149154 
     155   SUBROUTINE update_pointers( Kbb, Kmm, Kaa ) 
     156      !!---------------------------------------------------------------------- 
     157      !!                     ***  ROUTINE update_pointers  *** 
     158      !! 
     159      !! ** Purpose :   Associate temporary pointer arrays. 
     160      !!                For IMMERSE development phase only - to be deleted 
     161      !! 
     162      !! ** Method  : 
     163      !!---------------------------------------------------------------------- 
     164      INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
     165 
     166      ub => uu(:,:,:,Kbb); un => uu(:,:,:,Kmm); ua => uu(:,:,:,Kaa) 
     167      vb => vv(:,:,:,Kbb); vn => vv(:,:,:,Kmm); va => vv(:,:,:,Kaa) 
     168      wn => ww(:,:,:) 
     169      hdivn => hdiv(:,:,:) 
     170 
     171      sshb =>  ssh(:,:,Kbb); sshn =>  ssh(:,:,Kmm); ssha =>  ssh(:,:,Kaa) 
     172      ub_b => uu_b(:,:,Kbb); un_b => uu_b(:,:,Kmm); ua_b => uu_b(:,:,Kaa) 
     173      vb_b => vv_b(:,:,Kbb); vn_b => vv_b(:,:,Kmm); va_b => vv_b(:,:,Kaa) 
     174 
     175      tsb => ts(:,:,:,:,Kbb); tsn => ts(:,:,:,:,Kmm); tsa => ts(:,:,:,:,Kaa) 
     176 
     177      e3t_b => e3t(:,:,:,Kbb); e3t_n => e3t(:,:,:,Kmm); e3t_a => e3t(:,:,:,Kaa) 
     178      e3u_b => e3u(:,:,:,Kbb); e3u_n => e3u(:,:,:,Kmm); e3u_a => e3u(:,:,:,Kaa) 
     179      e3v_b => e3v(:,:,:,Kbb); e3v_n => e3v(:,:,:,Kmm); e3v_a => e3v(:,:,:,Kaa) 
     180 
     181      e3f_n => e3f(:,:,:) 
     182 
     183      e3w_b  => e3w (:,:,:,Kbb); e3w_n  => e3w (:,:,:,Kmm) 
     184      e3uw_b => e3uw(:,:,:,Kbb); e3uw_n => e3uw(:,:,:,Kmm) 
     185      e3vw_b => e3vw(:,:,:,Kbb); e3vw_n => e3vw(:,:,:,Kmm) 
     186 
     187      gdept_b => gdept(:,:,:,Kbb); gdept_n => gdept(:,:,:,Kmm)  
     188      gdepw_b => gdepw(:,:,:,Kbb); gdepw_n => gdepw(:,:,:,Kmm)  
     189      gde3w_n => gde3w(:,:,:) 
     190 
     191   END SUBROUTINE update_pointers 
     192 
    150193   !!====================================================================== 
    151194END MODULE step 

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

    r10880 r10922  
    116116         ! 
    117117         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
    118             &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     118            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC', Kmm )  ! add the eiv transport 
    119119         ! 
    120120         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 

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

    r10068 r10922  
    5151CONTAINS 
    5252 
    53    SUBROUTINE trc_ldf( kt ) 
     53   SUBROUTINE trc_ldf( kt, Kmm ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5959      !!---------------------------------------------------------------------- 
    6060      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     61      INTEGER, INTENT( in ) ::   Kmm  ! ocean time-level index 
    6162      ! 
    6263      INTEGER            :: ji, jj, jk, jn 
    … …  
    9798         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     ) 
    9899      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies) 
    99          CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1    ) 
     100         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1    , Kmm ) 
    100101      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral) 
    101          CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf_trc ) 
     102         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf_trc, Kmm ) 
    102103      END SELECT 
    103104      ! 

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

    r10884 r10922  
    7373         ENDIF 
    7474         !                                                       
    75                                 CALL trc_ldf    ( kt )      ! lateral mixing 
     75                                CALL trc_ldf    ( kt, Kmm ) ! lateral mixing 
    7676#if defined key_agrif 
    7777         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 

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

    r10905 r10922  
    8787      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    8888      !     
    89       IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
     89      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt, Kmm )  ! averaging physical variables for sub-stepping 
    9090      !     
    9191      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 

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

    r10425 r10922  
    8282CONTAINS 
    8383 
    84    SUBROUTINE trc_sub_stp( kt ) 
     84   SUBROUTINE trc_sub_stp( kt, Kmm ) 
    8585      !!------------------------------------------------------------------- 
    8686      !!                     ***  ROUTINE trc_stp  *** 
    … …  
    9292      !!------------------------------------------------------------------- 
    9393      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     94      INTEGER, INTENT( in ) ::   Kmm  ! ocean time-level index 
    9495      ! 
    9596      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    … …  
    282283         ENDIF 
    283284         ! 
    284          CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity 
     285         CALL trc_sub_ssh( kt, Kmm )         ! after ssh & vertical velocity 
    285286         ! 
    286287      ENDIF 
    … …  
    445446 
    446447 
    447    SUBROUTINE trc_sub_ssh( kt )  
     448   SUBROUTINE trc_sub_ssh( kt, Kmm )  
    448449      !!---------------------------------------------------------------------- 
    449450      !!                ***  ROUTINE trc_sub_ssh  *** 
    … …  
    464465      !!---------------------------------------------------------------------- 
    465466      INTEGER, INTENT(in) ::   kt   ! time step 
     467      INTEGER, INTENT(in) ::   Kmm  ! ocean time-level index 
    466468      ! 
    467469      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    484486      ! 
    485487!!gm BUG here !   hdivn will include the runoff divergence at the wrong timestep !!!! 
    486       CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity 
     488      CALL div_hor( kt, Kmm )                         ! Horizontal divergence & Relative vorticity 
    487489      ! 
    488490      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
Note: See TracChangeset for help on using the changeset viewer.