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

Ignore:
Timestamp:
2015-01-20T15:26:13+01:00 (9 years ago)
Author:
jamesharle
Message:

Merging branch with HEAD of the trunk

File:
1 edited

Legend:

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

    r4306 r5038  
    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 
     
    9795      !!              - emp     : freshwater budget: mass flux  
    9896      !!              - 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) 
    10197      !!              - fr_i    : ice fraction 
    10298      !!              - tn_ice  : sea-ice surface temperature 
    103       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     99      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    104100      !! 
    105101      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    183179 
    184180            !   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             
     181            IF( lk_cpl ) THEN 
     182               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     183            ELSE 
     184               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     185            ENDIF 
    190186            !  computation the non solar heat flux at ocean surface 
    191187            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
     
    206202            ! 
    207203            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    208 #if defined key_coupled 
    209204            !                                                  ! 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             
     205            IF( lk_cpl ) THEN 
     206               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     207                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     208            ELSE 
     209               !                                                  ! forced  mode:  
     210               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     211                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     212                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     213            ENDIF 
    218214            ! 
    219215            ! mass flux at the ocean/ice interface (sea ice fraction) 
     
    245241      ENDIF 
    246242 
    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 
     243      IF( iom_use('hflx_ice_cea' ) )   CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
     244      IF( iom_use('qns_io_cea'   ) )   CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )       
     245      IF( iom_use('qsr_io_cea'   ) )   CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
     246 
     247      IF( iom_use('isnwmlt_cea'  ) )   CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice ) 
     248      IF( iom_use('fsal_virt_cea') )   CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
     249      IF( iom_use('fsal_real_cea') )   CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
    256250 
    257251      !-----------------------------------------------! 
     
    259253      !-----------------------------------------------! 
    260254 
    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 
     255      IF( lk_cpl) THEN 
     256         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     257         ht_i(:,:,1) = hicif(:,:) 
     258         ht_s(:,:,1) = hsnif(:,:) 
     259         a_i(:,:,1) = fr_i(:,:) 
     260         !                                  ! Computation of snow/ice and ocean albedo 
     261         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     262         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     263         IF( iom_use('icealb_cea' ) )   CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     264      ENDIF 
    271265 
    272266      IF(ln_ctl) THEN            ! control print 
    273267         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    274268         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 ) 
    277269         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    278270      ENDIF  
Note: See TracChangeset for help on using the changeset viewer.