Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5034 r5600  
    2525   USE par_oce          ! ocean parameters 
    2626   USE phycst           ! physical constants 
    27    USE par_ice          ! ice parameters 
    2827   USE dom_oce          ! ocean domain 
    29    USE dom_ice,    ONLY : tms, area 
    3028   USE ice              ! LIM sea-ice variables 
    3129   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
    3230   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3331   USE sbccpl 
    34    USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     32   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3533   USE albedo           ! albedo parameters 
    3634   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     
    4038   USE prtctl           ! Print control 
    4139   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    42    USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     40   USE traqsr           ! add penetration of solar flux in the calculation of heat budget 
    4341   USE iom 
    4442   USE domvvl           ! Variable volume 
     43   USE limctl 
     44   USE limcons 
    4545 
    4646   IMPLICIT NONE 
    4747   PRIVATE 
    4848 
    49    PUBLIC   lim_sbc_init   ! called by ice_init 
     49   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5050   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5151   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
     
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
     96      !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    9999      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    100100      !!              These refs are now obsolete since everything has been revised 
    101       !!              The ref should be Rousset et al., 2015? 
     101      !!              The ref should be Rousset et al., 2015 
    102102      !!--------------------------------------------------------------------- 
    103       INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
    104       ! 
    105       INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
    106       ! 
    107       REAL(wp) ::   zemp                                            !  local scalars 
    108       REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    109       REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     103      INTEGER, INTENT(in) ::   kt                                  ! number of iteration 
     104      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices 
     105      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     106      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    110107      ! 
    111108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
     
    113110 
    114111      ! make calls for heat fluxes before it is modified 
    115       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
    116       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
    117       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface 
    118       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 
    119       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice 
    120       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
    121       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     112      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
     113      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     114      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
     115      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
     116      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
     117      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
     118      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
     119         &                                                      * 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(:,:) )   
    122122 
    123123      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     
    128128            !      heat flux at the ocean surface      ! 
    129129            !------------------------------------------! 
    130             ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     130            ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    131131            !--------------------------------------------------- 
    132             IF( lk_cpl ) THEN  
    133                !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    134                zfcm1 = qsr_tot(ji,jj) 
    135                DO jl = 1, jpl 
    136                   zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    137                END DO 
    138             ELSE 
    139                !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    140                zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
    141                DO jl = 1, jpl 
    142                   zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
    143                END DO 
    144             ENDIF 
     132            zqsr = qsr_tot(ji,jj) 
     133            DO jl = 1, jpl 
     134               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) )  
     135            END DO 
    145136 
    146137            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
    147138            !--------------------------------------------------- 
    148             zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    149             hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     139            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     140            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
     141 
     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) 
    150145 
    151146            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    152147            !--------------------------------------------------- 
    153             qsr(ji,jj) = zfcm1                                       
    154             qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     148            qsr(ji,jj) = zqsr                                       
     149            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
    155150 
    156151            !------------------------------------------! 
     
    165160            !                     Even if i see Ice melting as a FW and SALT flux 
    166161            !         
    167             !  computing freshwater exchanges at the ice/ocean interface 
    168             IF( lk_cpl ) THEN  
    169                zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    170                   &   + wfx_snw(ji,jj) 
    171             ELSE 
    172                zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
    173                   &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
    174                   &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    175             ENDIF 
    176  
    177162            ! mass flux from ice/ocean 
    178163            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     
    180165 
    181166            ! mass flux at the ocean/ice interface 
    182             fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model 
    183             emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     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) 
    184169             
    185170         END DO 
     
    199184         snwice_mass_b(:,:) = snwice_mass(:,:)                   
    200185         ! new mass per unit area 
    201          snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     186         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    202187         ! time evolution of snow+ice mass 
    203188         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
     
    210195      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    211196 
    212       !------------------------------------------------! 
    213       !    Snow/ice albedo (only if sent to coupler)   ! 
    214       !------------------------------------------------! 
    215       IF( lk_cpl ) THEN          ! coupled case 
    216  
    217             CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    218  
    219             CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    220  
    221             alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    222  
    223             CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
    224  
    225       ENDIF 
    226  
     197      !------------------------------------------------------------------------! 
     198      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   ! 
     199      !------------------------------------------------------------------------! 
     200      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )     
     201      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     202      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     203      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     204 
     205      ! conservation test 
     206      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 
     207 
     208      ! control prints 
     209      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    227210 
    228211      IF(ln_ctl) THEN 
     
    270253      ! 
    271254      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    272 !CDIR NOVERRCHK 
    273255         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    274 !CDIR NOVERRCHK 
    275256            DO ji = fs_2, fs_jpim1 
    276257               !                                               ! 2*(U_ice-U_oce) at T-point 
     
    322303      !! ** input   : Namelist namicedia 
    323304      !!------------------------------------------------------------------- 
    324       REAL(wp) :: zsum, zarea 
    325       ! 
    326305      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
    327306      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
     
    343322         END WHERE 
    344323      ENDIF 
    345       ! clem modif 
    346       IF( .NOT. ln_rstart ) THEN 
    347          fraqsr_1lev(:,:) = 1._wp 
    348       ENDIF 
    349       ! 
    350       ! clem: snwice_mass in the restart file now 
     324      ! 
    351325      IF( .NOT. ln_rstart ) THEN 
    352326         !                                      ! embedded sea ice 
    353327         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    354             snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     328            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    355329            snwice_mass_b(:,:) = snwice_mass(:,:) 
    356330         ELSE 
Note: See TracChangeset for help on using the changeset viewer.