Changeset 13364


Ignore:
Timestamp:
2020-07-30T17:05:58+02:00 (12 days ago)
Author:
techene
Message:

hydrostatic pressure gradient is computed with density anomaly when possible

Location:
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DYN/dynhpg.F90

    r13295 r13364  
    150150      !! 
    151151      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF 
    152       REAL(wp) ::   znad 
    153152      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zts_top, zrhd   ! hypothesys on isf density 
    154153      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  zrhdtop_isf    ! density at bottom of ISF 
     
    245244      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    246245      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    247       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
     246      REAL(wp), DIMENSION(jpi,jpj) ::  zhpi, zhpj 
    248247      !!---------------------------------------------------------------------- 
    249248      ! 
     
    253252         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
    254253      ENDIF 
    255  
    256       zcoef0 = - grav * 0.5_wp      ! Local constant initialization 
    257  
    258       ! Surface value 
    259       DO_2D( 0, 0, 0, 0 ) 
     254      ! 
     255      zcoef0 = - grav * 0.5_wp            ! Local constant initialization 
     256      ! 
     257      DO_2D( 0, 0, 0, 0 )                 ! Surface value 
    260258         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
    261          ! hydrostatic pressure gradient 
    262          zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
    263          zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    264          ! add to the general momentum trend 
    265          puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 
    266          pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 
     259         !                                   ! hydrostatic pressure gradient 
     260         zhpi(ji,jj) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     261         zhpj(ji,jj) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
     262         !                                   ! add to the general momentum trend 
     263         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj) 
     264         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj) 
    267265      END_2D 
    268  
    269       ! 
    270       ! interior value (2=<jk=<jpkm1) 
    271       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     266      ! 
     267      DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! interior value (2=<jk=<jpkm1) 
    272268         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
    273          ! hydrostatic pressure gradient 
    274          zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    275             &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    & 
    276             &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    277  
    278          zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    279             &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    & 
    280             &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    281          ! add to the general momentum trend 
    282          puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 
    283          pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 
     269         !                                   ! hydrostatic pressure gradient 
     270         zhpi(ji,jj) = zhpi(ji,jj) + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )  & 
     271            &                                  - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
     272 
     273         zhpj(ji,jj) = zhpj(ji,jj) + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )  & 
     274            &                                  - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
     275         !                                   ! add to the general momentum trend 
     276         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj) 
     277         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj) 
    284278      END_3D 
    285279      ! 
     
    390384      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    391385      !! 
    392       INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices 
    393       REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars 
    394       LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables 
     386      INTEGER  ::   ji, jj, jk, jii, jjj           ! dummy loop indices 
     387      REAL(wp) ::   zcoef0, zuap, zvap, ztmp       ! local scalars 
     388      LOGICAL  ::   ll_tmp1, ll_tmp2               ! local logical variables 
    395389      REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj 
    396390      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     
    406400      ! 
    407401      zcoef0 = - grav * 0.5_wp 
    408       IF ( ln_linssh ) THEN   ;   znad = 0._wp         ! Fixed    volume: density anomaly 
    409       ELSE                    ;   znad = 1._wp         ! Variable volume: density 
    410       ENDIF 
    411402      ! 
    412403      IF( ln_wd_il ) THEN 
     
    450441        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    451442      END IF 
    452  
    453       ! Surface value 
    454       DO_2D( 0, 0, 0, 0 ) 
    455          ! hydrostatic pressure gradient along s-surfaces 
    456          zhpi(ji,jj,1) =   & 
    457             &  zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    & 
    458             &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) & 
    459             &           * r1_e1u(ji,jj) 
    460          zhpj(ji,jj,1) =   & 
    461             &  zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    & 
    462             &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) & 
    463             &           * r1_e2v(ji,jj) 
    464          ! s-coordinate pressure gradient correction 
    465          zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     443      ! 
     444      DO_2D( 0, 0, 0, 0 )              ! Surface value 
     445         !                                   ! hydrostatic pressure gradient along s-surfaces 
     446         zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj)                      & 
     447            &          * (  e3w(ji+1,jj  ,1,Kmm) * rhd(ji+1,jj  ,1)  & 
     448            &             - e3w(ji  ,jj  ,1,Kmm) * rhd(ji  ,jj  ,1)  ) 
     449         zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj)                      & 
     450            &          * (  e3w(ji  ,jj+1,1,Kmm) * rhd(ji  ,jj+1,1)  & 
     451            &             - e3w(ji  ,jj  ,1,Kmm) * rhd(ji  ,jj  ,1)  ) 
     452         !                                   ! s-coordinate pressure gradient correction 
     453         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) )   & 
    466454            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 
    467          zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     455         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) )   & 
    468456            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 
    469457         ! 
     
    474462            zvap = zvap * zcpy(ji,jj) 
    475463         ENDIF 
    476          ! 
    477          ! add to the general momentum trend 
     464         !                                   ! add to the general momentum trend 
    478465         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) + zuap 
    479466         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) + zvap 
    480467      END_2D 
    481  
    482       ! interior value (2=<jk=<jpkm1) 
    483       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    484          ! hydrostatic pressure gradient along s-surfaces 
    485          zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    486             &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    487             &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    488          zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   & 
    489             &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
    490             &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    491          ! s-coordinate pressure gradient correction 
    492          zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
     468      ! 
     469      DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior value (2=<jk=<jpkm1) 
     470         !                                   ! hydrostatic pressure gradient along s-surfaces 
     471         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)                         & 
     472            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )  & 
     473            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) 
     474         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)                         & 
     475            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )  & 
     476            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) 
     477         !                                   ! s-coordinate pressure gradient correction 
     478         zuap = -zcoef0 * ( rhd  (ji+1,jj  ,jk) + rhd  (ji,jj,jk) ) & 
    493479            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) * r1_e1u(ji,jj) 
    494          zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )  & 
     480         zvap = -zcoef0 * ( rhd  (ji  ,jj+1,jk) + rhd  (ji,jj,jk) ) & 
    495481            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) * r1_e2v(ji,jj) 
    496482         ! 
     
    535521      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    536522      !! 
    537       INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
    538       REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars 
     523      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     524      INTEGER  ::   ikt ,  ikti1,  iktj1   ! local integer 
     525      REAL(wp) ::   ze3w, ze3wi1, ze3wj1   ! local scalars 
     526      REAL(wp) ::   zcoef0, zuap, zvap     !   -      - 
    539527      REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj 
    540528      REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top 
     
    543531      ! 
    544532      zcoef0 = - grav * 0.5_wp   ! Local constant initialization 
    545       ! 
    546       znad=1._wp                 ! To use density and not density anomaly 
    547533      ! 
    548534      !                          ! iniitialised to 0. zhpi zhpi  
     
    560546      CALL eos( zts_top, risfdep, zrhdtop_oce ) 
    561547 
    562 !==================================================================================      
    563 !===== Compute surface value =====================================================  
    564 !================================================================================== 
     548      !                     !===========================! 
     549      !                     !=====  surface value  =====! 
     550      !                     !===========================! 
    565551      DO_2D( 0, 0, 0, 0 ) 
    566          ikt    = mikt(ji,jj) 
    567          iktp1i = mikt(ji+1,jj) 
    568          iktp1j = mikt(ji,jj+1) 
    569          ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
    570          ! we assume ISF is in isostatic equilibrium 
    571          zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w(ji+1,jj,iktp1i,Kmm)                                    & 
    572             &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
    573             &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         & 
    574             &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
    575             &                                  + ( risfload(ji+1,jj) - risfload(ji,jj))                            )  
    576          zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm)                                    & 
    577             &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
    578             &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         &  
    579             &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
    580             &                                  + ( risfload(ji,jj+1) - risfload(ji,jj))                            )  
    581          ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    582          zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     552         ikt   = mikt(ji  ,jj  )   ;   ze3w   = e3w(ji  ,jj  ,ikt  ,Kmm) 
     553         ikti1 = mikt(ji+1,jj  )   ;   ze3wi1 = e3w(ji+1,jj  ,ikti1,Kmm) 
     554         iktj1 = mikt(ji  ,jj+1)   ;   ze3wj1 = e3w(ji  ,jj+1,iktj1,Kmm) 
     555         !                          ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
     556         !                          ! we assume ISF is in isostatic equilibrium 
     557         zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * (   risfload(ji+1,jj) - risfload(ji,jj)  & 
     558            &                                       + 0.5_wp * ( ze3wi1 * ( rhd(ji+1,jj,ikti1) + zrhdtop_oce(ji+1,jj) )     & 
     559            &                                                  - ze3w   * ( rhd(ji  ,jj,ikt  ) + zrhdtop_oce(ji  ,jj) ) )   ) 
     560         zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * (   risfload(ji,jj+1) - risfload(ji,jj)  & 
     561            &                                       + 0.5_wp * ( ze3wj1 * ( rhd(ji,jj+1,iktj1) + zrhdtop_oce(ji,jj+1) )      & 
     562            &                                                  - ze3w   * ( rhd(ji,jj  ,ikt  ) + zrhdtop_oce(ji,jj  ) ) )   )  
     563         !                          ! s-coordinate pressure gradient correction (=0 if z coordinate) 
     564         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) )   & 
    583565            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 
    584          zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     566         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) )   & 
    585567            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 
    586          ! add to the general momentum trend 
     568         !                          ! add to the general momentum trend 
    587569         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) 
    588570         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1) 
    589571      END_2D 
    590 !==================================================================================      
    591 !===== Compute interior value =====================================================  
    592 !================================================================================== 
    593       ! interior value (2=<jk=<jpkm1) 
     572      !    
     573      !                     !=============================! 
     574      !                     !=====  interior values  =====! 
     575      !                     !=============================! 
    594576      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    595          ! hydrostatic pressure gradient along s-surfaces 
     577         ze3w   = e3w(ji  ,jj  ,jk,Kmm) 
     578         ze3wi1 = e3w(ji+1,jj  ,jk,Kmm) 
     579         ze3wj1 = e3w(ji  ,jj+1,jk,Kmm) 
     580         !                          ! hydrostatic pressure gradient along s-surfaces 
    596581         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    597             &           * (  e3w(ji+1,jj,jk,Kmm)                   & 
    598             &                  * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
    599             &              - e3w(ji  ,jj,jk,Kmm)                   & 
    600             &                  * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
     582            &           * (  ze3wi1 * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) * wmask(ji+1,jj,jk)   & 
     583            &              - ze3w   * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) ) * wmask(ji  ,jj,jk)   ) 
    601584         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    602             &           * (  e3w(ji,jj+1,jk,Kmm)                   & 
    603             &                  * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
    604             &              - e3w(ji,jj  ,jk,Kmm)                   & 
    605             &                  * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
    606          ! s-coordinate pressure gradient correction 
    607          zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     585            &           * (  ze3wj1 * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) * wmask(ji,jj+1,jk)   & 
     586            &              - ze3w   * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) ) * wmask(ji,jj  ,jk)   ) 
     587         !                          ! s-coordinate pressure gradient correction 
     588         zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) )   & 
    608589            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) / e1u(ji,jj) 
    609          zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     590         zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) )   & 
    610591            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) / e2v(ji,jj) 
    611          ! add to the general momentum trend 
     592         !                          ! add to the general momentum trend 
    612593         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
    613594         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk) 
     
    634615      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    635616      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables 
     617      REAL(wp), DIMENSION(jpi,jpj)     ::   zpgu, zpgv   ! 2D workspace 
    636618      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj 
    637619      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dzx, dzy, dzz, dzu, dzv, dzw 
     
    826808      END_3D 
    827809      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1.0_wp, rho_i, 'U', 1.0_wp, rho_j, 'V', 1.0_wp ) 
    828  
     810      ! 
     811      ! --------------- 
     812      !  Surface pressure gradient to be removed 
     813      ! --------------- 
     814      DO_2D( 0, 0, 0, 0 ) 
     815         zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
     816         zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
     817      END_2D 
     818      ! 
    829819      ! --------------- 
    830820      !  Surface value 
     
    838828         ENDIF 
    839829         ! add to the general momentum trend 
    840          puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 
    841          pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 
     830         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) - zpgu(ji,jj) 
     831         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) - zpgv(ji,jj) 
    842832      END_2D 
    843833 
     
    858848         ENDIF 
    859849         ! add to the general momentum trend 
    860          puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 
    861          pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 
     850         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) - zpgu(ji,jj) 
     851         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) - zpgv(ji,jj) 
    862852      END_3D 
    863853      ! 
     
    892882      REAL(wp) :: zrhdt1 
    893883      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
     884      REAL(wp), DIMENSION(jpi,jpj)     ::   zpgu, zpgv   ! 2D workspace 
     885      REAL(wp), DIMENSION(jpi,jpj)     ::   zsshu_n, zsshv_n 
    894886      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh 
    895887      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    896       REAL(wp), DIMENSION(jpi,jpj)   ::   zsshu_n, zsshv_n 
    897888      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    898889      !!---------------------------------------------------------------------- 
     
    907898      zcoef0 = - grav 
    908899      znad = 1._wp 
    909       IF( ln_linssh )   znad = 0._wp 
    910  
     900      IF( ln_linssh )   znad = 1._wp 
     901      ! 
     902      ! --------------- 
     903      !  Surface pressure gradient to be removed 
     904      ! --------------- 
     905      DO_2D( 0, 0, 0, 0 ) 
     906         zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
     907         zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
     908      END_2D 
     909      ! 
    911910      IF( ln_wd_il ) THEN 
    912911         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     
    974973      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    975974      DO_2D( 1, 1, 1, 1 ) 
    976          zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 
     975         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) 
    977976      END_2D 
    978977 
     
    10251024 
    10261025      DO_2D( 0, 0, 0, 0 ) 
    1027        zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad)  
    1028        zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 
     1026       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) )  
     1027       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 
    10291028      END_2D 
    10301029 
     
    11081107            zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
    11091108         ENDIF 
    1110          puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk)  
     1109         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk)  
    11111110      ENDIF 
    11121111 
     
    11681167         ENDIF 
    11691168 
    1170          pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk) 
     1169         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 
    11711170      ENDIF 
    11721171         ! 
  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isf_oce.F90

    r12077 r13364  
    11MODULE isf_oce 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcisf  *** 
    4    !! Surface module :  compute iceshelf melt and heat flux 
     3   !!                       ***  MODULE  isf_oce  *** 
     4   !! Ice shelves :  ice shelves variables defined in memory 
    55   !!====================================================================== 
    66   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav 
     
    146146   END SUBROUTINE isf_alloc_par 
    147147 
     148    
    148149   SUBROUTINE isf_alloc_cav() 
    149150      !!--------------------------------------------------------------------- 
     
    173174   END SUBROUTINE isf_alloc_cav 
    174175 
     176    
    175177   SUBROUTINE isf_alloc_cpl() 
    176178      !!--------------------------------------------------------------------- 
     
    184186      ierr = 0 
    185187      ! 
    186       ALLOCATE( risfcpl_ssh(jpi,jpj), risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc ) 
    187       ierr = ierr + ialloc 
    188       ! 
    189       risfcpl_tsc(:,:,:,:) = 0.0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0 
    190  
    191       IF ( ln_isfcpl_cons) THEN 
    192          ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) ,risfcpl_cons_ssh(jpi,jpj), STAT=ialloc ) 
     188      ALLOCATE( risfcpl_ssh(jpi,jpj) , risfcpl_tsc(jpi,jpj,jpk,jpts) , risfcpl_vol(jpi,jpj,jpk) , STAT=ialloc ) 
     189      ierr = ierr + ialloc 
     190      ! 
     191      risfcpl_tsc(:,:,:,:) = 0._wp ; risfcpl_vol(:,:,:) = 0._wp ; risfcpl_ssh(:,:) = 0._wp 
     192 
     193      IF ( ln_isfcpl_cons ) THEN 
     194         ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) , risfcpl_cons_ssh(jpi,jpj) , STAT=ialloc ) 
    193195         ierr = ierr + ialloc 
    194196         ! 
    195          risfcpl_cons_tsc(:,:,:,:) = 0.0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0 
     197         risfcpl_cons_tsc(:,:,:,:) = 0._wp ; risfcpl_cons_vol(:,:,:) = 0._wp ; risfcpl_cons_ssh(:,:) = 0._wp 
    196198         ! 
    197199      END IF 
     
    202204   END SUBROUTINE isf_alloc_cpl 
    203205 
     206    
    204207   SUBROUTINE isf_dealloc_cpl() 
    205208      !!--------------------------------------------------------------------- 
     
    213216      ierr = 0 
    214217      ! 
    215       DEALLOCATE( risfcpl_ssh, risfcpl_tsc, risfcpl_vol, STAT=ialloc ) 
     218      DEALLOCATE( risfcpl_ssh , risfcpl_tsc , risfcpl_vol , STAT=ialloc ) 
    216219      ierr = ierr + ialloc 
    217220      ! 
     
    221224   END SUBROUTINE isf_dealloc_cpl 
    222225 
     226    
    223227   SUBROUTINE isf_alloc() 
    224228      !!--------------------------------------------------------------------- 
     
    233237      ierr = 0       ! set to zero if no array to be allocated 
    234238      ! 
    235       ALLOCATE(fwfisf_par(jpi,jpj)  , fwfisf_par_b(jpi,jpj), & 
    236          &     fwfisf_cav(jpi,jpj)  , fwfisf_cav_b(jpi,jpj), & 
    237          &     fwfisf_oasis(jpi,jpj),            STAT=ialloc ) 
    238       ierr = ierr + ialloc 
    239       ! 
    240       ALLOCATE(risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc ) 
    241       ierr = ierr + ialloc 
    242       ! 
    243       ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc ) 
    244       ierr = ierr + ialloc 
    245       ! 
    246       ALLOCATE(risfload(jpi,jpj), STAT=ialloc) 
    247       ierr = ierr + ialloc 
    248       ! 
    249       ALLOCATE( mskisf_cav(jpi,jpj), STAT=ialloc) 
     239      ALLOCATE( fwfisf_par  (jpi,jpj) , fwfisf_par_b(jpi,jpj) ,    & 
     240         &      fwfisf_cav  (jpi,jpj) , fwfisf_cav_b(jpi,jpj) ,    & 
     241         &      fwfisf_oasis(jpi,jpj)                         , STAT=ialloc ) 
     242      ierr = ierr + ialloc 
     243      ! 
     244      ALLOCATE( risf_par_tsc(jpi,jpj,jpts) , risf_par_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 
     245      ierr = ierr + ialloc 
     246      ! 
     247      ALLOCATE( risf_cav_tsc(jpi,jpj,jpts) , risf_cav_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 
     248      ierr = ierr + ialloc 
     249      ! 
     250      ALLOCATE( risfload(jpi,jpj) , STAT=ialloc ) 
     251      ierr = ierr + ialloc 
     252      ! 
     253      ALLOCATE( mskisf_cav(jpi,jpj) , STAT=ialloc ) 
    250254      ierr = ierr + ialloc 
    251255      ! 
     
    254258      ! 
    255259      ! initalisation of fwf and tsc array to 0 
    256       risfload(:,:)       = 0.0_wp 
    257       fwfisf_oasis(:,:)   = 0.0_wp 
    258       fwfisf_par(:,:)     = 0.0_wp    ; fwfisf_par_b(:,:)     = 0.0_wp 
    259       fwfisf_cav(:,:)     = 0.0_wp    ; fwfisf_cav_b(:,:)     = 0.0_wp 
    260       risf_cav_tsc(:,:,:) = 0.0_wp    ; risf_cav_tsc_b(:,:,:) = 0.0_wp 
    261       risf_par_tsc(:,:,:) = 0.0_wp    ; risf_par_tsc_b(:,:,:) = 0.0_wp 
    262       ! 
    263  
     260      risfload    (:,:)   = 0._wp 
     261      fwfisf_oasis(:,:)   = 0._wp 
     262      fwfisf_par  (:,:)   = 0._wp   ;   fwfisf_par_b  (:,:)   = 0._wp 
     263      fwfisf_cav  (:,:)   = 0._wp   ;   fwfisf_cav_b  (:,:)   = 0._wp 
     264      risf_cav_tsc(:,:,:) = 0._wp   ;   risf_cav_tsc_b(:,:,:) = 0._wp 
     265      risf_par_tsc(:,:,:) = 0._wp   ;   risf_par_tsc_b(:,:,:) = 0._wp 
     266      ! 
    264267   END SUBROUTINE isf_alloc 
    265  
     268    
     269   !!====================================================================== 
    266270END MODULE isf_oce 
  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfload.F90

    r13295 r13364  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  isfload  *** 
    4    !! isfload module :  compute ice shelf load (needed for the hpg) 
     4   !! Ice Shelves :   compute ice shelf load (needed for the hpg) 
    55   !!====================================================================== 
    66   !! History :  4.1  !  2019-09  (P. Mathiot) original code 
     
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   isfload      : compute ice shelf load 
     10   !!   isf_load      : compute ice shelf load 
    1111   !!---------------------------------------------------------------------- 
    1212 
     
    2323   PRIVATE 
    2424 
    25    PUBLIC isf_load 
     25   PUBLIC   isf_load   ! called by isfstp.F90 
     26   ! 
    2627   !! * Substitutions 
    2728#  include "do_loop_substitute.h90" 
    2829#  include "domzgr_substitute.h90" 
    29  
     30   !!---------------------------------------------------------------------- 
     31   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     32   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $ 
     33   !! Software governed by the CeCILL license (see ./LICENSE) 
     34   !!---------------------------------------------------------------------- 
    3035CONTAINS 
    3136 
     
    3742      !! 
    3843      !!-------------------------------------------------------------------- 
    39       !!-------------------------- OUT ------------------------------------- 
    40       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload 
    41       !!-------------------------- IN  ------------------------------------- 
    42       INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index 
     44      INTEGER,                      INTENT(in   ) ::   Kmm        ! ocean time level index       
     45      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pisfload   ! ice shelf load 
    4346      !!---------------------------------------------------------------------- 
    4447      ! 
     
    4649      !               the smaller the residual flow is, the better it is. 
    4750      ! 
    48       ! ice shelf cavity 
     51      ! type of ice shelf cavity 
    4952      SELECT CASE ( cn_isfload ) 
    5053      CASE ( 'uniform' ) 
     
    5659   END SUBROUTINE isf_load 
    5760 
    58    SUBROUTINE isf_load_uniform( Kmm, pisfload ) 
     61    
     62   SUBROUTINE isf_load_uniform( Kmm, pload ) 
    5963      !!-------------------------------------------------------------------- 
    6064      !!                  ***  SUBROUTINE isf_load  *** 
     
    6771      !! 
    6872      !!-------------------------------------------------------------------- 
    69       !!-------------------------- OUT ------------------------------------- 
    70       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload 
    71       !!-------------------------- IN  ------------------------------------- 
    72       INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index 
    73       !!-------------------------------------------------------------------- 
     73      INTEGER,                      INTENT(in   ) ::   Kmm     ! ocean time level index       
     74      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pload   ! ice shelf load 
     75      ! 
    7476      INTEGER  :: ji, jj, jk 
    7577      INTEGER  :: ikt 
    76       REAL(wp)                          :: znad        !  
    7778      REAL(wp), DIMENSION(jpi,jpj)      :: zrhdtop_isf ! water density    displaced by the ice shelf (at the interface) 
    7879      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top     ! water properties displaced by the ice shelf    
    7980      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: zrhd        ! water density    displaced by the ice shelf 
    8081      !!---------------------------------------------------------------------- 
    81       ! 
    82       znad = 1._wp                     !- To use density and not density anomaly 
    8382      ! 
    8483      !                                !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude) 
     
    8786      DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
    8887         CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) ) 
     88!!st ==>> CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 
    8989      END DO 
    9090      ! 
     
    9393      ! 
    9494      !                                !- Surface value + ice shelf gradient 
    95       pisfload(:,:) = 0._wp                       ! compute pressure due to ice shelf load  
     95      pload(:,:) = 0._wp                      ! compute pressure due to ice shelf load  
    9696      DO_2D( 1, 1, 1, 1 ) 
    9797         ikt = mikt(ji,jj) 
    9898         ! 
    9999         IF ( ikt > 1 ) THEN 
     100            !                                 ! top layer of the ice shelf 
     101            pload(ji,jj) = pload(ji,jj)   & 
     102               &         + zrhd (ji,jj,1) * e3w(ji,jj,1,Kmm) 
    100103            ! 
    101             ! top layer of the ice shelf 
    102             pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) )   & 
    103                &                                * e3w(ji,jj,1,Kmm) 
    104             ! 
    105             ! core layers of the ice shelf 
    106             DO jk = 2, ikt-1 
    107                pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk))   & 
    108                   &                                * e3w(ji,jj,jk,Kmm) 
     104            DO jk = 2, ikt-1                  ! core layers of the ice shelf 
     105               pload(ji,jj) = pload(ji,jj) + (zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk))   & 
     106                  &                        *   e3w(ji,jj,jk,Kmm) 
    109107            END DO 
    110             ! 
    111             ! deepest part of the ice shelf (between deepest T point and ice/ocean interface 
    112             pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 
    113                &                                              * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) ) 
     108            !                                 ! deepest part of the ice shelf (between deepest T point and ice/ocean interface 
     109            pload(ji,jj) = pload(ji,jj) + ( zrhdtop_isf(ji,jj) +  zrhd(ji,jj,ikt-1)     )   & 
     110               &                        * (     risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) ) 
     111!!st ==>>     &                        * (     risfdep(ji,jj) - gdept_0(ji,jj,ikt-1) ) 
    114112            ! 
    115113         END IF 
     
    117115      ! 
    118116   END SUBROUTINE isf_load_uniform 
    119  
     117    
     118   !!====================================================================== 
    120119END MODULE isfload 
  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfstp.F90

    r13237 r13364  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  isfstp  *** 
    4    !! Surface module :  compute iceshelf load, melt and heat flux 
     4   !! Ice Shelves :  compute iceshelf load, melt and heat flux 
    55   !!====================================================================== 
    66   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav 
     
    4242   !! Software governed by the CeCILL license (see ./LICENSE) 
    4343   !!---------------------------------------------------------------------- 
    44  
    4544CONTAINS 
    4645  
    47   SUBROUTINE isf_stp( kt, Kmm ) 
     46   SUBROUTINE isf_stp( kt, Kmm ) 
    4847      !!--------------------------------------------------------------------- 
    4948      !!                  ***  ROUTINE isf_stp  *** 
     
    5857      !!              - compute fluxes 
    5958      !!              - write restart variables 
    60       !! 
    61       !!---------------------------------------------------------------------- 
    62       INTEGER, INTENT(in) ::   kt   ! ocean time step 
    63       INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    64       !!---------------------------------------------------------------------- 
    65       INTEGER :: jk                               ! loop index 
    66       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t    ! e3t  
     59      !!---------------------------------------------------------------------- 
     60      INTEGER, INTENT(in) ::   kt    ! ocean time step 
     61      INTEGER, INTENT(in) ::   Kmm   ! ocean time level index 
     62      ! 
     63      INTEGER :: jk                              ! loop index 
     64#if defined key_qco 
     65      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t   ! 3D workspace 
     66#endif 
    6767      !!--------------------------------------------------------------------- 
    6868      ! 
     
    8383         ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 
    8484         rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 
     85#if defined key_qco 
    8586         DO jk = 1, jpk 
    8687            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    8788         END DO  
    88          CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 
     89         CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
     90#else 
     91         CALL isf_tbl_lvl( ht(:,:),  e3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 
     92#endif 
    8993         ! 
    9094         ! 1.3: compute ice shelf melt 
    91          CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav) 
     95         CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav ) 
    9296         ! 
    9397      END IF 
     
    108112         ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 
    109113         rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 
     114#if defined key_qco 
    110115         DO jk = 1, jpk 
    111116            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    112117         END DO 
    113          CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 
     118         CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     119#else 
     120         CALL isf_tbl_lvl( ht(:,:),  e3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     121#endif 
    114122         ! 
    115123         ! 2.3: compute ice shelf melt 
    116          CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par) 
     124         CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par ) 
    117125         ! 
    118126      END IF 
     
    128136   END SUBROUTINE isf_stp 
    129137 
    130    SUBROUTINE isf_init(Kbb, Kmm, Kaa) 
     138    
     139   SUBROUTINE isf_init( Kbb, Kmm, Kaa ) 
    131140      !!--------------------------------------------------------------------- 
    132141      !!                  ***  ROUTINE isfstp_init  *** 
     
    142151      !!              - call cav/param/isfcpl init routine 
    143152      !!---------------------------------------------------------------------- 
    144       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa      ! ocean time level indices 
     153      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa   ! ocean time level indices 
     154      !!---------------------------------------------------------------------- 
    145155      ! 
    146156      ! constrain: l_isfoasis need to be known 
    147157      ! 
    148       ! Read namelist 
    149       CALL isf_nam() 
    150       ! 
    151       ! Allocate public array 
    152       CALL isf_alloc() 
    153       ! 
    154       ! check option compatibility 
    155       CALL isf_ctl() 
    156       ! 
    157       ! compute ice shelf load 
    158       IF ( ln_isfcav ) CALL isf_load( Kmm, risfload ) 
     158      CALL isf_nam()                                              ! Read namelist 
     159      ! 
     160      CALL isf_alloc()                                            ! Allocate public array 
     161      ! 
     162      CALL isf_ctl()                                              ! check option compatibility 
     163      ! 
     164      IF( ln_isfcav ) CALL isf_load( Kmm, risfload )              ! compute ice shelf load 
    159165      ! 
    160166      ! terminate routine now if no ice shelf melt formulation specify 
    161       IF ( ln_isf ) THEN 
    162          ! 
    163          !--------------------------------------------------------------------------------------------------------------------- 
    164          ! initialisation melt in the cavity 
    165          IF ( ln_isfcav_mlt ) CALL isf_cav_init() 
    166          ! 
    167          !--------------------------------------------------------------------------------------------------------------------- 
    168          ! initialisation parametrised melt 
    169          IF ( ln_isfpar_mlt ) CALL isf_par_init() 
    170          ! 
    171          !--------------------------------------------------------------------------------------------------------------------- 
    172          ! initialisation ice sheet coupling 
    173          IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa) 
     167      IF( ln_isf ) THEN 
     168         ! 
     169         IF( ln_isfcav_mlt )   CALL isf_cav_init()                ! initialisation melt in the cavity 
     170         ! 
     171         IF( ln_isfpar_mlt )   CALL isf_par_init()                ! initialisation parametrised melt 
     172         ! 
     173         IF( ln_isfcpl     )   CALL isfcpl_init( Kbb, Kmm, Kaa )  ! initialisation ice sheet coupling 
    174174         ! 
    175175      END IF 
     
    177177  END SUBROUTINE isf_init 
    178178 
     179   
    179180  SUBROUTINE isf_ctl() 
    180181      !!--------------------------------------------------------------------- 
     
    283284      END IF 
    284285   END SUBROUTINE isf_ctl 
    285    ! 
     286 
     287    
    286288   SUBROUTINE isf_nam 
    287289      !!--------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.