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 4924 for branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 – NEMO

Ignore:
Timestamp:
2014-11-28T18:24:01+01:00 (9 years ago)
Author:
mathiot
Message:

UKM02_ice_shelves merged and SETTE tested with revision 4879 of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r4924  
    2727   USE par_ice          ! ice parameters 
    2828   USE dom_oce          ! ocean domain 
    29    USE domvvl           ! ocean vertical scale factors 
    30    USE dom_ice,    ONLY : tms 
     29   USE dom_ice,    ONLY : tms, area 
    3130   USE ice              ! LIM sea-ice variables 
    3231   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     
    4342   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4443   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     44   USE iom 
     45   USE domvvl           ! Variable volume 
    4546 
    4647   IMPLICIT NONE 
     
    5152   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    5253 
    53    REAL(wp)  ::   rzero  = 0._wp     
    54    REAL(wp)  ::   rone   = 1._wp 
     54   REAL(wp)  ::   epsi10 = 1.e-10   ! 
     55   REAL(wp)  ::   epsi20 = 1.e-20   ! 
    5556 
    5657   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
     
    104105      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    105106      ! 
    106       INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    107       INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    108       INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    109       REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
    110       REAL(wp) ::   zemp_snw                          !   -      - 
    111       REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
     107      INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
     108      REAL(wp) ::   zinda, zemp      ! local scalars 
     109      REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     110      REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    112111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    113       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
    114112      !!--------------------------------------------------------------------- 
    115113       
    116114      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    117115 
    118       !------------------------------------------! 
    119       !      heat flux at the ocean surface      ! 
    120       !------------------------------------------! 
     116      ! make calls for heat fluxes before it is modified 
     117      CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
     118      CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
     119      CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  !     solar flux at ice surface 
     120      CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  ! non-solar flux at ice surface 
     121      CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  !     solar flux transmitted thru ice 
     122      CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
     123      CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     124 
    121125      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    122       ! changed to old_frld and old ht_i 
    123  
    124126      DO jj = 1, jpj 
    125127         DO ji = 1, jpi 
    126             zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    127             ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
    128             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    129             idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    130             iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    131             ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr 
    132             iadv    = ( 1  - i1mfr ) * zinda 
    133             ifral   = ( 1  - i1mfr * ( 1 - ial ) )    
    134             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    135  
    136             ! switch --- 1.0 ---------------- 0.0 -------------------- 
    137             ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    138             ! zinda   | if pfrld = 1       | if pfrld < 1            | 
    139             !  -> ifvt| if pfrld old_ht_i 
    140             ! i1mfr   | if frld = 1        | if frld  < 1            | 
    141             ! idfr    | if frld <= pfrld    | if frld > pfrld        | 
    142             ! iflt    |  
    143             ! ial     | 
    144             ! iadv    | 
    145             ! ifral 
    146             ! ifrdv 
    147  
    148             !   computation the solar flux at ocean surface 
    149             IF (lk_cpl) THEN ! be carfeful: not been tested yet 
     128 
     129            !------------------------------------------! 
     130            !      heat flux at the ocean surface      ! 
     131            !------------------------------------------! 
     132            zinda   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 
     133 
     134            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     135            !--------------------------------------------------- 
     136            IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    150137               ! original line 
    151                !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
    152                ! new line to include solar penetration (not tested) 
    153                zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     138               zfcm1 = qsr_tot(ji,jj) 
     139               !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    154140               DO jl = 1, jpl 
    155                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     141                  zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    156142               END DO 
    157143            ELSE 
    158                zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    159                     &    ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     144               !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     145               !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     146               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
     147               DO jl = 1, jpl 
     148                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
     149               END DO 
    160150            ENDIF 
    161             ! fstric     Solar flux transmitted trough the ice 
    162             ! qsr        Net short wave heat flux on free ocean 
    163             ! new line 
    164             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    165  
    166             ! solar flux and fscmbq with light penetration (clem) 
    167             zzfcm1  = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
    168             zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    169  
    170             !  computation the non solar heat flux at ocean surface 
    171             zfcm2 = - zzfcm1                                                                    & ! 
    172                &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    173                &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    174                &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
    175                &    + fhmec(ji,jj)                                                              & ! snow melt when ridging 
    176                &    + fheat_mec(ji,jj)                                                          & ! ridge formation 
    177                &    + fheat_res(ji,jj)                                                            ! residual heat flux 
    178             ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    179             ! qldif   heat balance of the lead (or of the open ocean) 
    180             ! qfvbq   latent heat uptake/release after accretion/ablation 
    181             ! qdtcn   Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    182  
    183             IF( num_sal == 2 )   zfcm2 = zfcm2 + fhbri(ji,jj)    ! add contribution due to brine drainage  
    184  
    185             ! bottom radiative component is sent to the computation of the oceanic heat flux 
    186             fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
    187  
    188             ! used to compute the oceanic heat flux at the next time step 
    189             qsr(ji,jj) = zfcm1                                       ! solar heat flux  
    190             qns(ji,jj) = zfcm2 - fdtcn(ji,jj)                        ! non solar heat flux 
    191             !                           ! fdtcn : turbulent oceanic heat flux 
    192          END DO 
    193       END DO 
    194  
    195       !------------------------------------------! 
    196       !      mass flux at the ocean surface      ! 
    197       !------------------------------------------! 
    198  
    199 !!gm   optimisation: this loop have to be merged with the previous one 
    200       DO jj = 1, jpj 
    201          DO ji = 1, jpi 
     151 
     152            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     153            !--------------------------------------------------- 
     154            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     155            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     156 
     157            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     158            !--------------------------------------------------- 
     159            qsr(ji,jj) = zfcm1                                       
     160            qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     161 
     162            !------------------------------------------! 
     163            !      mass flux at the ocean surface      ! 
     164            !------------------------------------------! 
    202165            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    203166            !  -------------------------------------------------------------------------------------  
     
    208171            !                     Even if i see Ice melting as a FW and SALT flux 
    209172            !         
    210  
    211173            !  computing freshwater exchanges at the ice/ocean interface 
    212             IF (lk_cpl) THEN  
     174            IF( lk_cpl ) THEN  
    213175               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    214                   &   - rdm_snw(ji,jj) / rdt_ice 
     176                  &   + wfx_snw(ji,jj) 
    215177            ELSE 
    216                zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    217                   &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    218                   &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    219                   &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     178               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
     179                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
     180                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    220181            ENDIF 
    221182 
    222             ! mass flux at the ocean/ice interface (sea ice fraction) 
    223             zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
    224             zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus melting   
    225  
    226             fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model 
    227  
    228             emp(ji,jj) = zemp + zemp_snw + zfmm  ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     183            ! mass flux from ice/ocean 
     184            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     185                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     186 
     187            ! mass flux at the ocean/ice interface 
     188            fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice                   ! F/M mass flux save at least for biogeochemical model 
     189            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    229190             
    230             !  correcting brine salt fluxes   (zinda = 1  if pfrld=1 , =0 otherwise) 
    231             zinda        = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    232             sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 
    233191         END DO 
    234192      END DO 
     
    237195      !      salt flux at the ocean surface      ! 
    238196      !------------------------------------------! 
    239  
    240       IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    241          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 
    242       ELSE                         ! constant ice salinity: 
    243          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 
    244       ENDIF 
    245       !-----------------------------------------------! 
    246       !   mass of snow and ice per unit area          ! 
    247       !-----------------------------------------------! 
    248       IF( nn_ice_embd /= 0 ) THEN                               ! embedded sea-ice (mass required) 
    249          snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
    250          !                                                      ! new mass per unit area 
     197      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
     198         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     199 
     200      !-------------------------------------------------------------! 
     201      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     202      !-------------------------------------------------------------! 
     203      IF( nn_ice_embd /= 0 ) THEN 
     204         ! save mass from the previous ice time step 
     205         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     206         ! new mass per unit area 
    251207         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    252          !                                                      ! time evolution of snow+ice mass 
     208         ! time evolution of snow+ice mass 
    253209         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    254210      ENDIF 
     
    265221      IF( lk_cpl ) THEN          ! coupled case 
    266222         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    267          ! 
    268223         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    269224      ENDIF 
     225 
    270226 
    271227      IF(ln_ctl) THEN 
Note: See TracChangeset for help on using the changeset viewer.