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 5581 for branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90 – NEMO

Ignore:
Timestamp:
2015-07-10T13:28:53+02:00 (9 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r4306 r5581  
    3030   USE sbc_oce          ! surface boundary condition: ocean 
    3131   USE sbccpl 
    32    USE cpl_oasis3, ONLY : lk_cpl 
    3332   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3433   USE albedo           ! albedo parameters 
     
    3736   USE wrk_nemo         ! work arrays 
    3837   USE in_out_manager   ! I/O manager 
    39    USE diaar5, ONLY :   lk_diaar5 
    4038   USE iom              ! I/O library 
    4139   USE prtctl           ! Print control 
     
    4846   PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2 
    4947   PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2 
    50    PUBLIC   lim_bio_meanqsr_2  ! called by sbc_ice_lim_2 
    5148 
    5249   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     
    9794      !!              - emp     : freshwater budget: mass flux  
    9895      !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting 
    99       !!              - utau    : sea surface i-stress (ocean referential) 
    100       !!              - vtau    : sea surface j-stress (ocean referential) 
    10196      !!              - fr_i    : ice fraction 
    10297      !!              - tn_ice  : sea-ice surface temperature 
    103       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     98      !!              - alb_ice : sea-ice albedo (ln_cpl=T) 
    10499      !! 
    105100      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    183178 
    184179            !   computation the solar flux at ocean surface 
    185 #if defined key_coupled  
    186             zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    187 #else 
    188             zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    189 #endif             
     180            IF( ln_cpl ) THEN 
     181               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     182            ELSE 
     183               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     184            ENDIF 
    190185            !  computation the non solar heat flux at ocean surface 
    191186            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
     
    206201            ! 
    207202            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    208 #if defined key_coupled 
    209203            !                                                  ! coupled mode:  
    210             zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
    211                &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
    212 #else 
    213             !                                                  ! forced  mode:  
    214             zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
    215                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
    216                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
    217 #endif             
     204            IF( ln_cpl ) THEN 
     205               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     206                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     207            ELSE 
     208               !                                                  ! forced  mode:  
     209               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     210                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     211                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     212            ENDIF 
    218213            ! 
    219214            ! mass flux at the ocean/ice interface (sea ice fraction) 
     
    245240      ENDIF 
    246241 
    247       CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
    248       CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )       
    249       CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
    250  
    251       IF( lk_diaar5 ) THEN       ! AR5 diagnostics 
    252          CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice ) 
    253          CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
    254          CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
    255       ENDIF 
     242      IF( iom_use('hflx_ice_cea' ) )   CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
     243      IF( iom_use('qns_io_cea'   ) )   CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )       
     244      IF( iom_use('qsr_io_cea'   ) )   CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
     245 
     246      IF( iom_use('isnwmlt_cea'  ) )   CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice ) 
     247      IF( iom_use('fsal_virt_cea') )   CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
     248      IF( iom_use('fsal_real_cea') )   CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
    256249 
    257250      !-----------------------------------------------! 
     
    259252      !-----------------------------------------------! 
    260253 
    261 #if defined key_coupled 
    262       tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    263       ht_i(:,:,1) = hicif(:,:) 
    264       ht_s(:,:,1) = hsnif(:,:) 
    265       a_i(:,:,1) = fr_i(:,:) 
    266       !                                  ! Computation of snow/ice and ocean albedo 
    267       CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
    268       alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
    269       CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    270 #endif 
     254      IF( ln_cpl) THEN 
     255         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     256         ht_i(:,:,1) = hicif(:,:) 
     257         ht_s(:,:,1) = hsnif(:,:) 
     258         a_i(:,:,1) = fr_i(:,:) 
     259         !                                  ! Computation of snow/ice and ocean albedo 
     260         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     261         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     262         IF( iom_use('icealb_cea' ) )   CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     263      ENDIF 
    271264 
    272265      IF(ln_ctl) THEN            ! control print 
    273266         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    274267         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx   , clinfo2=' sfx     : ') 
    275          CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    276             &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask ) 
    277268         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    278269      ENDIF  
     
    438429   END SUBROUTINE lim_sbc_tau_2 
    439430 
    440    SUBROUTINE lim_bio_meanqsr_2 
    441       !!--------------------------------------------------------------------- 
    442       !!                     ***  ROUTINE lim_bio_meanqsr 
    443       !! 
    444       !! ** Purpose :   provide daily qsr_mean for PISCES when  
    445       !!                analytic diurnal cycle is applied in physic 
    446       !! 
    447       !! ** Method  :   add part under ice 
    448       !! 
    449       !!--------------------------------------------------------------------- 
    450  
    451       qsr_mean(:,:) =  pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:) 
    452  
    453    END SUBROUTINE lim_bio_meanqsr_2 
    454431 
    455432   SUBROUTINE lim_sbc_init_2 
Note: See TracChangeset for help on using the changeset viewer.