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

Changeset 15529


Ignore:
Timestamp:
2021-11-23T16:00:19+01:00 (2 years ago)
Author:
techene
Message:

#2695 : isf+qco are now compatible

Location:
NEMO/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/DOM/domzgr.F90

    r15052 r15529  
    236236      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level 
    237237      ! 
    238       INTEGER  ::   jk     ! dummy loop index 
     238      INTEGER  ::   ji,jj,jk     ! dummy loop index 
    239239      INTEGER  ::   inum, iatt 
    240240      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav 
     
    270270      ENDIF 
    271271      ! ------- keep compatibility with OLD VERSION... end ------- 
     272      ! 
     273      !                          !* ocean top and bottom level 
     274      CALL iom_get( inum, jpdom_global, 'top_level'    , z2d   )   ! 1st wet T-points (ISF) 
     275      k_top(:,:) = NINT( z2d(:,:) ) 
     276      CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d   )   ! last wet T-points 
     277      k_bot(:,:) = NINT( z2d(:,:) ) 
    272278      ! 
    273279      !                          !* vertical scale factors 
     
    299305         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth 
    300306         CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths 
     307#if defined key_qco && key_isf 
     308         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )        ! vertical sum at partial cell xxxx other level   
     309            IF( jk == k_top(ji,jj) ) THEN                               ! first ocean point : partial cell 
     310               gdept_0(ji,jj,jk) = gdepw_0(ji,jj,jk  ) + 0.5_wp * e3w_0(ji,jj,jk)   ! = risfdep + 1/2 e3w_0(mikt) 
     311            ELSE                                                        !  other levels 
     312               gdept_0(ji,jj,jk) = gdept_0(ji,jj,jk-1) +          e3w_0(ji,jj,jk)  
     313            ENDIF 
     314         END_3D 
     315#endif 
    301316         IF(lwp) THEN 
    302317            WRITE(numout,*) 
     
    307322      ENDIF 
    308323      ! 
    309       !                          !* ocean top and bottom level 
    310       CALL iom_get( inum, jpdom_global, 'top_level'    , z2d   )   ! 1st wet T-points (ISF) 
    311       k_top(:,:) = NINT( z2d(:,:) ) 
    312       CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d   )   ! last wet T-points 
    313       k_bot(:,:) = NINT( z2d(:,:) ) 
    314       ! 
    315324      ! reference depth for negative bathy (wetting and drying only) 
    316325      IF( ll_wd )  CALL iom_get( inum,  'rn_wd_ref_depth' , ssh_ref   ) 
  • NEMO/trunk/src/OCE/DOM/domzgr_substitute.h90

    r14143 r15529  
    2525#   define  r1_hu(i,j,t)   (r1_hu_0(i,j)/(1._wp+r3u(i,j,t))) 
    2626#   define  r1_hv(i,j,t)   (r1_hv_0(i,j)/(1._wp+r3v(i,j,t))) 
     27# if defined key_isf 
     28#   define  gdept(i,j,k,t) ((gdept_0(i,j,k)-risfdep(i,j))*(1._wp+r3t(i,j,t))+risfdep(i,j))  
     29#   define  gdepw(i,j,k,t) ((gdepw_0(i,j,k)-risfdep(i,j))*(1._wp+r3t(i,j,t))+risfdep(i,j)) 
     30# else 
    2731#   define  gdept(i,j,k,t) (gdept_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    2832#   define  gdepw(i,j,k,t) (gdepw_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    29 #   define  gde3w(i,j,k)   (gdept_0(i,j,k)*(1._wp+r3t(i,j,Kmm))-ssh(i,j,Kmm)) 
     33# endif 
     34#   define  gde3w(i,j,k)   (gdept(i,j,k,Kmm)-ssh(i,j,Kmm)) 
    3035#elif defined key_linssh 
    3136#   define  e3t(i,j,k,t)   e3t_0(i,j,k) 
  • NEMO/trunk/src/OCE/DYN/dynhpg.F90

    r14834 r15529  
    189189         &   CALL ctl_stop( 'dyn_hpg_init : ln_hpg_isf=T requires ln_isfcav=T and vice versa' )   
    190190      ! 
    191 #if defined key_qco 
    192       IF( ln_hpg_isf ) THEN 
    193          CALL ctl_stop( 'dyn_hpg_init : key_qco and ln_hpg_isf not yet compatible' ) 
    194       ENDIF 
    195 #endif 
    196191      ! 
    197192      !                               ! Set nhpg from ln_hpg_... flags & consistency check 
     
    555550      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) ::  zhpi, zhpj 
    556551      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::  zts_top 
    557       REAL(wp), DIMENSION(A2D(nn_hls))      ::  zrhdtop_oce 
     552      REAL(wp), DIMENSION(A2D(nn_hls))      ::  zrhd_top, zdep_top 
    558553      !!---------------------------------------------------------------------- 
    559554      ! 
     
    569564         zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
    570565         zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
    571       END_2D 
    572       CALL eos( zts_top, risfdep, zrhdtop_oce ) 
     566         zdep_top(ji,jj)  = MAX( risfdep(ji,jj) , gdept(ji,jj,1,Kmm) ) 
     567      END_2D 
     568      CALL eos( zts_top, zdep_top, zrhd_top ) 
    573569 
    574570      !                     !===========================! 
     
    582578         !                          ! we assume ISF is in isostatic equilibrium 
    583579         zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * (   risfload(ji+1,jj) - risfload(ji,jj)  & 
    584             &                                       + 0.5_wp * ( ze3wi1 * ( rhd(ji+1,jj,ikti1) + zrhdtop_oce(ji+1,jj) )     & 
    585             &                                                  - ze3w   * ( rhd(ji  ,jj,ikt  ) + zrhdtop_oce(ji  ,jj) ) )   ) 
     580            &                                       + 0.5_wp * ( ze3wi1 * ( rhd(ji+1,jj,ikti1) + zrhd_top(ji+1,jj) )     & 
     581            &                                                  - ze3w   * ( rhd(ji  ,jj,ikt  ) + zrhd_top(ji  ,jj) ) )   ) 
    586582         zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * (   risfload(ji,jj+1) - risfload(ji,jj)  & 
    587             &                                       + 0.5_wp * ( ze3wj1 * ( rhd(ji,jj+1,iktj1) + zrhdtop_oce(ji,jj+1) )      & 
    588             &                                                  - ze3w   * ( rhd(ji,jj  ,ikt  ) + zrhdtop_oce(ji,jj  ) ) )   )  
     583            &                                       + 0.5_wp * ( ze3wj1 * ( rhd(ji,jj+1,iktj1) + zrhd_top(ji,jj+1) )      & 
     584            &                                                  - ze3w   * ( rhd(ji,jj  ,ikt  ) + zrhd_top(ji,jj  ) ) )   ) 
    589585         !                          ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    590586         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) )   & 
  • NEMO/trunk/src/OCE/ISF/isfload.F90

    r15053 r15529  
    8484      zts_top(:,:,jp_tem) = rn_isfload_T   ;   zts_top(:,:,jp_sal) = rn_isfload_S 
    8585      ! 
    86       DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
     86      DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf 
     87#if defined key_qco && key_isf 
     88         CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 
     89#else  
    8790         CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) ) 
    88 !!st ==>> CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 
     91#endif 
    8992      END DO 
    9093      ! 
     
    99102         IF ( ikt > 1 ) THEN 
    100103            !                                 ! top layer of the ice shelf 
     104#if defined key_qco && key_isf 
     105            pload(ji,jj) = pload(ji,jj) + zrhd(ji,jj,1) * e3w_0(ji,jj,1)  
     106            !  
     107            DO jk = 2, ikt-1                  ! core layers of the ice shelf  
     108               pload(ji,jj) = pload(ji,jj) + (zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_0(ji,jj,jk)  
     109            END DO  
     110            !                                 ! deepest part of the ice shelf (between deepest T point and ice/ocean interface  
     111            pload(ji,jj) = pload(ji,jj) + ( zrhdtop_isf(ji,jj) +    zrhd(ji,jj,ikt-1) )   &  
     112               &                        * (     risfdep(ji,jj) - gdept_0(ji,jj,ikt-1) )  
     113#else 
    101114            pload(ji,jj) = pload(ji,jj)   & 
    102115               &         + zrhd (ji,jj,1) * e3w(ji,jj,1,Kmm) 
     
    109122            pload(ji,jj) = pload(ji,jj) + ( zrhdtop_isf(ji,jj) +  zrhd(ji,jj,ikt-1)     )   & 
    110123               &                        * (     risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) ) 
    111 !!st ==>>     &                        * (     risfdep(ji,jj) - gdept_0(ji,jj,ikt-1) ) 
     124#endif 
    112125            ! 
    113126         END IF 
  • NEMO/trunk/src/OCE/ISF/isfstp.F90

    r14995 r15529  
    195195         ! 
    196196         IF ( ln_isf ) THEN 
     197#if key_qco  
     198# if ! defined key_isf  
     199            CALL ctl_stop( 'STOP', 'isf_ctl: ice shelf requires both ln_isf=T AND key_isf activated' )  
     200# endif  
     201#endif 
    197202            WRITE(numout,*) '      Add debug print in isf module           ln_isfdebug     = ', ln_isfdebug 
    198203            WRITE(numout,*) 
  • NEMO/trunk/tests/ISOMIP+/MY_SRC/tradmp.F90

    r14995 r15529  
    5353   !! * Substitutions 
    5454#  include "do_loop_substitute.h90" 
     55#  include "domzgr_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    9697      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    9798      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
     99      REAL(wp), DIMENSION(jpi,jpj,jpk)              ::  ze3t 
    98100      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
    99101      !!---------------------------------------------------------------------- 
     
    141143      ! 
    142144      ! outputs (clem trunk) 
     145      DO jk = 1, jpk 
     146         ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
     147      END DO       
     148      ! 
    143149      IF( iom_use('hflx_dmp_cea') )       & 
    144150         &   CALL iom_put('hflx_dmp_cea', & 
    145          &   SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * e3t(:,:,:,Kmm), dim=3 ) * rcp * rho0 ) ! W/m2 
     151         &   SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * ze3t(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2 
    146152      IF( iom_use('sflx_dmp_cea') )       & 
    147153         &   CALL iom_put('sflx_dmp_cea', & 
    148          &   SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * e3t(:,:,:,Kmm), dim=3 ) * rho0 )       ! g/m2/s 
     154         &   SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * ze3t(:,:,:), dim=3 ) * rho0 )       ! g/m2/s 
    149155      ! 
    150156      IF( l_trdtra )   THEN       ! trend diagnostic 
Note: See TracChangeset for help on using the changeset viewer.