Ignore:
Timestamp:
2015-06-19T17:18:00+02:00 (5 years ago)
Author:
davestorkey
Message:

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5234 r5443  
    101101      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
    102102      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
     103      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice  
    103104      !!---------------------------------------------------------------------- 
    104  
    105       CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    106105 
    107106      IF( kt == nit000 ) THEN 
     
    124123         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 
    125124# endif 
     125 
     126         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     127         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
     128 
    126129         !  Bulk Formulea ! 
    127130         !----------------! 
     
    132135               DO ji = 2, jpi   ! NO vector opt. possible 
    133136                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) & 
    134                      &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     137                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    135138                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) & 
    136                      &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     139                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    137140               END DO 
    138141            END DO 
     
    158161 
    159162         SELECT CASE( ksbc ) 
    160          CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     163         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations 
    161164 
    162165            ! albedo depends on cloud fraction because of non-linear spectral effects 
     
    182185         SELECT CASE( ksbc ) 
    183186         CASE( jp_clio )           ! CLIO bulk formulation 
    184             CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    185                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    186                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    187                &                      tprecip    , sprecip    ,                         & 
    188                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     187!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
     188!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
     189!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
     190!              &                      tprecip    , sprecip    ,                         & 
     191!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     192            CALL blk_ice_clio_tau 
     193            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 
    189194 
    190195         CASE( jp_core )           ! CORE bulk formulation 
    191             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    192                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    193                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    194                &                      tprecip    , sprecip    ,                         & 
    195                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    196             IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
    197  
    198          CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     196            CALL blk_ice_core_tau 
     197            CALL blk_ice_core_flx( zsist, zalb_ice ) 
     198 
     199         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    199200            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    200201         END SELECT 
     202          
     203         IF( ln_mixcpl) THEN 
     204            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     205            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     206            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     207         ENDIF 
    201208 
    202209         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point 
     
    228235         END IF 
    229236         !                                             ! Ice surface fluxes in coupled mode  
    230          IF( ksbc == jp_cpl )   THEN 
     237         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations 
    231238            a_i(:,:,1)=fr_i 
    232239            CALL sbc_cpl_ice_flx( frld,                                              & 
    233240            !                                optional arguments, used only in 'mixed oce-ice' case 
    234             &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
     241            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist ) 
    235242            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    236243         ENDIF 
    237244                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    238245                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    239 #if defined key_top 
    240         IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2 
    241 #endif 
    242246 
    243247         IF(  .NOT. lk_mpp )THEN 
     
    253257         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
    254258# endif 
     259         ! 
     260         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     261         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    255262         ! 
    256263      ENDIF                                    ! End sea-ice time step only 
     
    264271      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    265272      ! 
    266       CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    267       ! 
    268273   END SUBROUTINE sbc_ice_lim_2 
    269274 
Note: See TracChangeset for help on using the changeset viewer.