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 6498 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 – NEMO

Ignore:
Timestamp:
2016-04-27T16:01:22+02:00 (8 years ago)
Author:
timgraham
Message:

Merge head of nemo_v3_6_STABLE into package branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6486 r6498  
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
     96      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    106106      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    107107      ! 
    108       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
     108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace 
     109      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace 
    109110      !!--------------------------------------------------------------------- 
    110111 
    111112      ! make calls for heat fluxes before it is modified 
     113      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    112114      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
    113115      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     
    118120      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
    119121         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
    120       IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )   
    121       IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )   
    122  
    123       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     122      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
     123      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
     124      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
     125      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
     126 
     127      ! albedo output 
     128      CALL wrk_alloc( jpi,jpj, zalb )     
     129 
     130      zalb(:,:) = 0._wp 
     131      WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     132      ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 
     133      END WHERE 
     134      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
     135 
     136      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )       
     137      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
     138 
     139      CALL wrk_dealloc( jpi,jpj, zalb )     
     140      ! 
     141       
    124142      DO jj = 1, jpj 
    125143         DO ji = 1, jpi 
     
    140158            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
    141159 
    142             ! Add the residual from heat diffusion equation (W.m-2) 
    143             !------------------------------------------------------- 
    144             hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 
     160            ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
     161            !---------------------------------------------------------------------- 
     162            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   & 
     163               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
    145164 
    146165            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    147             !--------------------------------------------------- 
     166            !---------------------------------------------------------------------------- 
    148167            qsr(ji,jj) = zqsr                                       
    149168            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
     
    165184 
    166185            ! mass flux at the ocean/ice interface 
    167             fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model 
    168             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    169              
     186            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
     187            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    170188         END DO 
    171189      END DO 
     
    175193      !------------------------------------------! 
    176194      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    177          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     195         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
    178196 
    179197      !-------------------------------------------------------------! 
Note: See TracChangeset for help on using the changeset viewer.