Changeset 8404


Ignore:
Timestamp:
2017-08-07T15:05:37+02:00 (3 years ago)
Author:
clem
Message:

start changing calls in icestp.F90

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90

    r8378 r8404  
    2828   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2929   USE sbc_ice         ! Surface boundary condition: ice   fields 
    30    USE usrdef_sbc      ! user defined: surface boundary condition 
    31    USE sbcblk          ! Surface boundary condition: bulk 
    32    USE sbccpl          ! Surface boundary condition: coupled interface 
    33    USE albedoice       ! ice albedo 
     30   USE iceforcing      ! Surface boundary condition for sea ice 
    3431   ! 
    3532   USE phycst          ! Define parameters for the routines 
     
    142139         END DO 
    143140         ! 
     141                                      CALL ice_bef         ! Store previous ice values 
    144142         !------------------------------------------------! 
    145143         ! --- Dynamical coupling with the atmosphere --- ! 
    146144         !------------------------------------------------! 
    147          ! It provides the following fields: 
    148          ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2] 
    149          !----------------------------------------------------------------- 
    150                                       CALL ice_bef         ! Store previous ice values 
    151          SELECT CASE( ksbc ) 
    152             CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    153             CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk formulation 
    154             CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
    155          END SELECT 
    156  
    157          IF( ln_mixcpl) THEN                                                       ! Case of a mixed Bulk/Coupled formulation 
    158                                       CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    159             utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    160             vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    161          ENDIF 
    162  
     145         ! it provides: 
     146         !    utau_ice, vtau_ice = surface ice stress [N/m2] 
     147         !-------------------------------------------------- 
     148                                      CALL ice_forcing_tau( kt, ksbc, utau_ice, vtau_ice ) 
     149                                       
    163150         !-------------------------------------------------------! 
    164151         ! --- ice dynamics and transport (except in 1D case) ---! 
    165152         !-------------------------------------------------------! 
    166                                       CALL ice_diag0       ! set diag of mass, heat and salt fluxes to 0 
     153                                      CALL ice_diag0           ! set diag of mass, heat and salt fluxes to 0 
    167154                                      CALL lim_rst_opn( kt )   ! Open Ice restart file 
    168155         ! 
     
    198185         ! --- Thermodynamical coupling with the atmosphere --- ! 
    199186         !------------------------------------------------------! 
    200          ! It provides the following fields: 
    201          ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2] 
    202          ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2] 
    203          ! dqns_ice, dqla_ice : non solar & latent heat sensistivity   (T-point)         [W/m2] 
    204          ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s] 
    205          ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    206          !---------------------------------------------------------------------------------------- 
    207           
    208                                       CALL albedo_ice( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos MV MP 2016 
    209  
    210          SELECT CASE( ksbc ) 
    211             CASE( jp_usr )   ;        CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation 
    212             CASE( jp_blk )                                          ! bulk formulation 
    213                ! albedo depends on cloud fraction because of non-linear spectral effects 
    214                alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    215                                       CALL blk_ice_flx( t_su, alb_ice ) 
    216                IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    217                IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    218             CASE ( jp_purecpl ) 
    219                ! albedo depends on cloud fraction because of non-linear spectral effects 
    220                alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    221                                       CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    222                IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    223          END SELECT 
     187         ! It provides the following fields used in sea ice model: 
     188         !    fr1_i0  , fr2_i0                         = 1sr & 2nd fraction of qsr penetration in ice  [%] 
     189         !    emp_oce , emp_ice                        = E-P over ocean and sea ice                    [Kg/m2/s] 
     190         !    sprecip                                  = solid precipitation                           [Kg/m2/s] 
     191         !    evap_ice                                 = sublimation                                   [Kg/m2/s] 
     192         !    qsr_tot , qns_tot                        = solar & non solar heat flux (total)           [W/m2] 
     193         !    qsr_ice , qns_ice                        = solar & non solar heat flux over ice          [W/m2] 
     194         !    dqns_ice                                 = non solar  heat sensistivity                  [W/m2] 
     195         !    qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2] 
     196         !------------------------------------------------------------------------------------------------------ 
     197                                      CALL ice_forcing_flx( kt, ksbc ) 
    224198 
    225199         !----------------------------! 
     
    489463   END SUBROUTINE ice_itd_init 
    490464 
    491  
    492    SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    493       !!--------------------------------------------------------------------- 
    494       !!                  ***  ROUTINE ice_lim_flx  *** 
    495       !! 
    496       !! ** Purpose :   update the ice surface boundary condition by averaging and / or 
    497       !!                redistributing fluxes on ice categories 
    498       !! 
    499       !! ** Method  :   average then redistribute 
    500       !! 
    501       !! ** Action  : 
    502       !!--------------------------------------------------------------------- 
    503       INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ; 
    504       !                                                         ! = 1 average and redistribute ; =2 redistribute 
    505       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature 
    506       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo 
    507       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux 
    508       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux 
    509       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity 
    510       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation 
    511       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity 
    512       ! 
    513       INTEGER  ::   jl      ! dummy loop index 
    514       ! 
    515       REAL(wp), DIMENSION(jpi,jpj) :: zalb_m    ! Mean albedo over all categories 
    516       REAL(wp), DIMENSION(jpi,jpj) :: ztem_m    ! Mean temperature over all categories 
    517       ! 
    518       REAL(wp), DIMENSION(jpi,jpj) :: z_qsr_m   ! Mean solar heat flux over all categories 
    519       REAL(wp), DIMENSION(jpi,jpj) :: z_qns_m   ! Mean non solar heat flux over all categories 
    520       REAL(wp), DIMENSION(jpi,jpj) :: z_evap_m  ! Mean sublimation over all categories 
    521       REAL(wp), DIMENSION(jpi,jpj) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    522       REAL(wp), DIMENSION(jpi,jpj) :: z_devap_m ! Mean d(evap)/dT over all categories 
    523       !!---------------------------------------------------------------------- 
    524       ! 
    525       IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx') 
    526       ! 
    527       SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
    528       CASE( 0 , 1 ) 
    529          ! 
    530          z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
    531          z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
    532          z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
    533          z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 
    534          z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 
    535          DO jl = 1, jpl 
    536             pdqn_ice  (:,:,jl) = z_dqn_m(:,:) 
    537             pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    538          END DO 
    539          ! 
    540          DO jl = 1, jpl 
    541             pqns_ice (:,:,jl) = z_qns_m(:,:) 
    542             pqsr_ice (:,:,jl) = z_qsr_m(:,:) 
    543             pevap_ice(:,:,jl) = z_evap_m(:,:) 
    544          END DO 
    545          ! 
    546       END SELECT 
    547       ! 
    548       SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==! 
    549       CASE( 1 , 2 ) 
    550          ! 
    551          zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 
    552          ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) ) 
    553          DO jl = 1, jpl 
    554             pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
    555             pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
    556             pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
    557          END DO 
    558          ! 
    559       END SELECT 
    560       ! 
    561       IF( nn_timing == 1 )  CALL timing_stop('ice_lim_flx') 
    562       ! 
    563    END SUBROUTINE ice_lim_flx 
    564  
    565  
    566465   SUBROUTINE ice_bef 
    567466      !!---------------------------------------------------------------------- 
     
    574473      ! 
    575474      DO jl = 1, jpl 
    576           
    577          DO jj = 1, jpj 
    578             DO ji = 1, jpi 
     475         DO jj = 2, jpjm1 
     476            DO ji = 2, jpim1 
    579477               a_i_b  (ji,jj,jl)   = a_i  (ji,jj,jl)     ! ice area 
    580478               v_i_b  (ji,jj,jl)   = v_i  (ji,jj,jl)     ! ice volume 
     
    589487               ht_s_b(ji,jj,jl) = v_s_b (ji,jj,jl) / MAX( a_i_b(ji,jj,jl) , epsi20 ) * rswitch 
    590488            END DO 
    591          END DO 
    592                    
     489         END DO    
    593490      END DO 
     491      CALL lbc_lnk_multi( a_i_b, 'T', 1., v_i_b , 'T', 1., v_s_b , 'T', 1., smv_i_b, 'T', 1., & 
     492         &               oa_i_b, 'T', 1., ht_i_b, 'T', 1., ht_s_b, 'T', 1. ) 
     493      CALL lbc_lnk( e_i_b, 'T', 1. ) 
     494      CALL lbc_lnk( e_s_b, 'T', 1. ) 
    594495       
    595496      ! ice velocities & total concentration 
    596       DO jj = 1, jpj 
    597          DO ji = 1, jpi 
     497      DO jj = 2, jpjm1 
     498         DO ji = 2, jpim1 
    598499            at_i_b(ji,jj)  = SUM( a_i_b(ji,jj,:) ) 
    599500            u_ice_b(ji,jj) = u_ice(ji,jj) 
     
    601502         END DO 
    602503      END DO 
     504      CALL lbc_lnk_multi( at_i_b, 'T', 1., u_ice_b , 'U', -1., v_ice_b , 'V', -1. ) 
    603505       
    604506   END SUBROUTINE ice_bef 
     
    662564   END SUBROUTINE ice_diag0 
    663565 
    664  
    665    FUNCTION fice_cell_ave ( ptab ) 
    666       !!-------------------------------------------------------------------------- 
    667       !! * Compute average over categories, for grid cell (ice covered and free ocean) 
    668       !!-------------------------------------------------------------------------- 
    669       REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 
    670       REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 
    671       INTEGER :: jl ! Dummy loop index 
    672  
    673       fice_cell_ave (:,:) = 0._wp 
    674       DO jl = 1, jpl 
    675          fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 
    676       END DO 
    677  
    678    END FUNCTION fice_cell_ave 
    679  
    680  
    681    FUNCTION fice_ice_ave ( ptab ) 
    682       !!-------------------------------------------------------------------------- 
    683       !! * Compute average over categories, for ice covered part of grid cell 
    684       !!-------------------------------------------------------------------------- 
    685       REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 
    686       REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 
    687  
    688       fice_ice_ave (:,:) = 0.0_wp 
    689       WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
    690  
    691    END FUNCTION fice_ice_ave 
    692  
    693566#else 
    694567   !!---------------------------------------------------------------------- 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r8378 r8404  
    107107      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    108108      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace 
    109       REAL(wp), DIMENSION(jpi,jpj)     ::   zalb                 ! 2D workspace 
    110109      !!--------------------------------------------------------------------- 
    111110 
     
    120119      ENDIF 
    121120       
    122       ! albedo output 
    123       zalb(:,:) = 0._wp 
    124       WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = rn_alb_oce 
    125       ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    126       END WHERE 
    127       IF( iom_use('icealb'  ) )  CALL iom_put( "icealb"   , zalb(:,:) )          ! ice albedo output 
    128  
    129       zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b )       
    130       IF( iom_use('albedo'  ) )        CALL iom_put( "albedo"  , zalb(:,:) )           ! surface albedo output 
    131  
    132  
    133121      DO jj = 1, jpj 
    134122         DO ji = 1, jpi 
Note: See TracChangeset for help on using the changeset viewer.