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 4733 for branches/2014 – NEMO

Changeset 4733 for branches/2014


Ignore:
Timestamp:
2014-07-30T15:52:48+02:00 (10 years ago)
Author:
vancop
Message:

Fix energy budget in coupled case

Location:
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4730 r4733  
    230230   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    231231   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    232    ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    233232   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    234233   nn_ice      = 2         !  =0 no ice boundary condition   , 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4730 r4733  
    2929   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3030   USE wrk_nemo         ! work arrays 
    31    USE cpl_oasis3, ONLY : lk_cpl 
    3231 
    3332   IMPLICIT NONE 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4730 r4733  
    9898      !!              - fr_i    : ice fraction 
    9999      !!              - tn_ice  : sea-ice surface temperature 
    100       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     100      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    101101      !! 
    102102      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    136136            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
    137137            !--------------------------------------------------- 
    138             IF( lk_cpl ) THEN ! be careful: not been tested yet 
    139                ! original line 
     138            IF( lk_cpl ) THEN  
     139               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    140140               zfcm1 = qsr_tot(ji,jj) 
    141                !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    142141               DO jl = 1, jpl 
    143142                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4688 r4733  
    6868      !!                ***  ROUTINE lim_thd  ***        
    6969      !!   
    70       !! ** Purpose : This routine manages the ice thermodynamic. 
     70      !! ** Purpose : This routine manages ice thermodynamics 
    7171      !!          
    7272      !! ** Action : - Initialisation of some variables 
     
    7474      !!               at the ice base, snow acc.,heat budget of the leads) 
    7575      !!             - selection of the icy points and put them in an array 
    76       !!             - call lim_vert_ther for vert ice thermodynamic 
    77       !!             - back to the geographic grid 
    78       !!             - selection of points for lateral accretion 
    79       !!             - call lim_lat_acc  for the ice accretion 
     76      !!             - call lim_thd_dif  for vertical heat diffusion 
     77      !!             - call lim_thd_dh   for vertical ice growth and melt 
     78      !!             - call lim_thd_ent  for enthalpy remapping 
     79      !!             - call lim_thd_sal  for ice desalination 
     80      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy 
    8081      !!             - back to the geographic grid 
    8182      !!      
    82       !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
     83      !! ** References :  
    8384      !!--------------------------------------------------------------------- 
    8485      INTEGER, INTENT(in) ::   kt    ! number of iteration 
     
    9394      ! 
    9495      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     96      ! 
     97      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9598      !!------------------------------------------------------------------- 
     99      CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
     100 
    96101      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    97102 
     
    137142      !-----------------------------------------------------------------------------! 
    138143 
     144      !--- Ocean solar and non solar fluxes to be used in zqld 
     145      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
     146         ! 
     147         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
     148         ! 
     149      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
     150         ! 
     151         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
     152         ! 
     153         DO jl = 1, jpl 
     154            DO jj = 1, jpj 
     155               DO ji = 1, jpi 
     156                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 
     157                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 
     158               END DO 
     159            END DO 
     160         END DO 
     161         ! 
     162      ENDIF 
     163 
    139164!CDIR NOVERRCHK 
    140165      DO jj = 1, jpj 
     
    149174            !           !  temperature and turbulent mixing (McPhee, 1992) 
    150175            ! 
     176 
    151177            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    152             zqld =  tms(ji,jj) * rdt_ice *                                       & 
    153                &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
    154                &                           + qns(ji,jj) )                        &   ! non solar heat 
    155                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    156                &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     178            zqld =  tms(ji,jj) * rdt_ice *                                          & 
     179               &  ( pfrld(ji,jj)         * ( zqsr(ji,jj) * oatte(ji,jj) + zqns(ji,jj) )  
     180               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) *     & ! heat content of precip 
     181               &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
    157182               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     183               ! REMARK valid at least in forced mode from clem 
     184               ! precip is included in qns but not in qns_ice 
    158185 
    159186            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     
    482509      ENDIF 
    483510      ! 
     511      ! 
     512      CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
     513 
     514      ! 
    484515      ! conservation test 
    485516      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    486517      ! 
    487518      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     519 
    488520   END SUBROUTINE lim_thd  
    489521 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4688 r4733  
    166166      ! 
    167167      DO ji = kideb, kiut 
    168          zinda         = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 
    169          ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt 
    170  
    171          zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    172          zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     168         zinda      = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 
     169         ztmelts    = zinda * rtt + ( 1._wp - zinda ) * rtt 
     170 
     171         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     172         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    173173 
    174174         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4688 r4733  
    146146      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid   ! tridiagonal system terms 
    147147      ! diag errors on heat 
    148       REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 
    149       REAL(wp)                        :: zhfx_err 
     148      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 
    150149      !!------------------------------------------------------------------      
    151150      !  
     
    158157      CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 
    159158 
    160       CALL wrk_alloc( jpij, zdq, zq_ini ) 
     159      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
    161160 
    162161      ! --- diag error on heat diffusion - PART 1 --- ! 
     
    407406         !------------------------------------------------------------------------------| 
    408407         ! 
    409          DO ji = kideb , kiut 
    410             ! update of the non solar flux according to the update in T_su 
    411             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
    412  
     408         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     409            DO ji = kideb , kiut 
     410               ! update of the non solar flux according to the update in T_su 
     411               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 
     412            END DO 
     413         ENDIF 
     414 
     415         ! Update incoming flux 
     416         DO ji = kideb , kiut 
    413417            ! update incoming flux 
    414418            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    415                + qns_ice_1d(ji)                  ! non solar total flux  
     419               + qns_ice_1d(ji)                   ! non solar total flux  
    416420            ! (LWup, LWdw, SH, LH) 
    417421         END DO 
     
    737741      CALL lim_thd_enmelt( kideb, kiut ) 
    738742 
    739       ! --- diag error on heat diffusion - PART 2 --- ! 
     743      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    740744      DO ji = kideb, kiut 
    741745         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) +  & 
    742746            &                              SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 
    743          zhfx_err    = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
    744          hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 
    745          ! --- correction of qns_ice and surface conduction flux --- ! 
    746          qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
    747          fc_su     (ji) = fc_su     (ji) - zhfx_err  
    748          ! --- Heat flux at the ice surface in W.m-2 --- ! 
     747         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     748         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_b(ji) 
     749      END DO  
     750 
     751      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
     752      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
     753         ! 
     754         DO ji = kideb, kiut 
     755            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
     756            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
     757         END DO 
     758         ! 
     759      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
     760         ! 
     761         DO ji = kideb, kiut 
     762            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
     763         END DO 
     764         ! 
     765      ENDIF 
     766 
     767      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 
     768      DO ji = kideb, kiut 
    749769         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    750770         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     
    759779      CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 
    760780      CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 
    761       CALL wrk_dealloc( jpij, zdq, zq_ini ) 
     781      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
    762782 
    763783   END SUBROUTINE lim_thd_dif 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4730 r4733  
    3535   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    37    LOGICAL , PUBLIC ::   ln_cpl         !: coupled   formulation (overwritten by key_sbc_coupled ) 
    3837   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    3938   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4730 r4733  
    518518      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    519519      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    520       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     520      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    521521      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    522522      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4730 r4733  
    11251125      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11261126      ! optional arguments, used only in 'mixed oce-ice' case 
    1127       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1127      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
     1128      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    11291129      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    11301130      ! 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4732 r4733  
    8282      INTEGER ::   icpt   ! local integer 
    8383      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     84      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    8585         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    8686         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
     
    123123         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124124         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    125          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    126125         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    127126         WRITE(numout,*) '           Misc. options of sbc : ' 
     
    237236      IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    238237      IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    239       IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
     238      IF( lk_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    240239      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    241240      IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r4624 r4733  
    166166      !! note that we need sbc_ssm called first in sbc 
    167167      ! 
    168       IF( ln_cpl ) THEN 
    169          IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme' 
    170          ln_cpl = .FALSE. 
    171       ENDIF 
    172168      IF( ln_apr_dyn ) THEN 
    173169         IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' 
Note: See TracChangeset for help on using the changeset viewer.