Changeset 8370


Ignore:
Timestamp:
2017-07-25T17:14:14+02:00 (4 years ago)
Author:
clem
Message:

put limthd_da into the same loop as the other thermodynamics routines

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r8369 r8370  
    266266            END IF 
    267267            ! 
     268            IF( ln_limdA )    CALL lim_thd_da                       ! --- lateral melting --- ! 
     269            ! 
    268270            DO jk = 1, nlay_i                                       ! --- Change units from J/m3 to J/m2 --- ! 
    269271               e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) * ht_i_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_i 
     
    279281         ! 
    280282      END DO 
    281       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    282  
    283       ! Change thickness to volume 
    284       v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
    285       v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    286       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    287       IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    288  
    289       IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_thd_da', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    290       IF( ln_limdA)           CALL lim_thd_da                       ! --- lateral melting --- ! 
    291283 
    292284      ! Change thickness to volume 
     
    295287      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    296288      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    297       IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_thd_da', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     289      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    298290 
    299291      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
     
    466458         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res          ) 
    467459         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr          ) 
     460         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam          ) 
    468461         ! 
    469462         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog          ) 
     
    474467         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res          ) 
    475468         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub          ) 
     469         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam          ) 
    476470         ! 
    477471         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd          ) 
     
    528522         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res          ) 
    529523         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr          ) 
     524         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam          ) 
    530525         ! 
    531526         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog          ) 
     
    536531         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res          ) 
    537532         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub          ) 
    538  
     533         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam          ) 
     534         ! 
    539535         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd          ) 
    540536         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr          ) 
     
    551547         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem   ) 
    552548         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out          ) 
    553  
     549         ! 
    554550         CALL tab_1d_2d( nidx, idxice(1:nidx), qns_ice_1d  (1:nidx), qns_ice(:,:,jl)  ) 
    555551         CALL tab_1d_2d( nidx, idxice(1:nidx), ftr_ice_1d  (1:nidx), ftr_ice(:,:,jl)  ) 
    556          ! 
    557552         ! 
    558553         ! SIMIP diagnostics          
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90

    r8369 r8370  
    1414   USE par_oce        ! ocean parameters 
    1515   USE phycst         ! physical constants (ocean directory) 
    16    USE sbc_oce , ONLY : sst_m 
    1716   USE ice            ! LIM variables 
    1817   USE thd_ice        ! thermodynamic sea-ice variables 
    19    USE limtab         ! 1D <==> 2D transformation 
    2018   ! 
    2119   USE lib_mpp        ! MPP library 
     
    10098      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167. 
    10199      !!--------------------------------------------------------------------- 
    102       INTEGER             ::   ji, jj, jk, jl     ! dummy loop indices 
    103       REAL(wp) ::   ztmelts             ! local scalar 
    104       REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg) 
    105       REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg) 
    106       REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg) 
     100      INTEGER  ::   ji     ! dummy loop indices 
    107101      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda 
    108102      REAL(wp), PARAMETER ::   zdmax = 300._wp 
     
    114108      !!--------------------------------------------------------------------- 
    115109 
    116       ! select ice covered grid points 
    117       nidx = 0 ; idxice(:) = 0 
    118       DO jj = 1, jpj 
    119          DO ji = 1, jpi 
    120             IF ( at_i(ji,jj) > epsi10 ) THEN 
    121                nidx         = nidx  + 1 
    122                idxice(nidx) = (jj - 1) * jpi + ji 
     110      !------------------------------------------------------------! 
     111      !------------------------------------------------------------! 
     112      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
     113      DO ji = 1, nidx    
     114         ! --- Calculate reduction of total sea ice concentration --- ! 
     115         zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m] 
     116         zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2] 
     117         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s] 
     118          
     119         zda_tot(ji) = MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0) 
     120       
     121         ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- ! 
     122         IF( a_i_1d(ji) > 0._wp ) THEN 
     123            ! decrease of concentration for the category jl 
     124            !    each category contributes to melting in proportion to its concentration 
     125            zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) ) 
     126             
     127            ! Contribution to salt flux 
     128            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoic *  ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice 
     129             
     130            ! Contribution to heat flux into the ocean [W.m-2], (<0)   
     131            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( ht_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  & 
     132                                                                + ht_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) )  
     133             
     134            ! Contribution to mass flux 
     135            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) ) 
     136             
     137            !! adjust e_i ??? 
     138!!            e_i_1d(ji,1:nlay_i) = e_i_1d(ji,1:nlay_i) * ( 1._wp - zda / a_i_1d(ji) ) 
     139!!            e_s_1d(ji,1)        = e_s_1d(ji,1)        * ( 1._wp - zda / a_i_1d(ji) ) 
     140             
     141            ! new concentration 
     142            a_i_1d(ji) = a_i_1d(ji) - zda 
     143             
     144            ! ensure that ht_i = 0 where a_i = 0 
     145            IF( a_i_1d(ji) == 0._wp ) THEN 
     146               ht_i_1d(ji) = 0._wp 
     147               ht_s_1d(ji) = 0._wp 
    123148            ENDIF 
    124          END DO 
     149         ENDIF 
    125150      END DO 
    126  
    127       IF( nidx > 0 ) THEN 
    128          !------------------------------------------------------------! 
    129          ! --- Calculate reduction of total sea ice concentration --- ! 
    130          !------------------------------------------------------------! 
    131          CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i  ) 
    132          CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d(1:nidx), t_bo  ) 
    133          CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d (1:nidx), sst_m ) 
    134           
    135          zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
    136          DO ji = 1, nidx    
    137             zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m] 
    138             zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2] 
    139             zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s] 
    140              
    141             zda_tot(ji) = - MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )               ! sea ice concentration decrease 
    142          END DO 
    143           
    144          !---------------------------------------------------------------------------------------------! 
    145          ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- ! 
    146          !---------------------------------------------------------------------------------------------! 
    147          CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam ) 
    148          CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd ) 
    149          CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam ) 
    150           
    151          DO jl = 1, jpl 
    152              
    153             CALL tab_2d_1d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl)  ) 
    154             CALL tab_2d_1d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,jl) ) 
    155             CALL tab_2d_1d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,jl) ) 
    156             CALL tab_2d_1d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,jl) ) 
    157             DO jk = 1, nlay_i 
    158                CALL tab_2d_1d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) ) 
    159             END DO 
    160             DO jk = 1, nlay_s 
    161                CALL tab_2d_1d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) ) 
    162             END DO 
    163              
    164             DO ji = 1, nidx 
    165                IF( a_i_1d(ji) > 0._wp ) THEN 
    166                   ! decrease of concentration for the category jl 
    167                   !    each category contributes to melting in proportion to its concentration 
    168                   zda = zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) 
    169                    
    170                   ! Contribution to salt flux 
    171                   sfx_lam_1d(ji) = sfx_lam_1d(ji) - rhoic *  ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice 
    172                    
    173                   ! Contribution to heat flux into the ocean [W.m-2], (<0)   
    174                   hfx_thd_1d(ji) = hfx_thd_1d(ji) + zda_tot(ji) / at_i_1d(ji) * SUM( e_i_1d(ji,1:nlay_i) + e_s_1d(ji,1) ) * r1_rdtice  
    175                    
    176                   ! Contribution to mass flux 
    177                   wfx_lam_1d(ji) =  wfx_lam_1d(ji) - zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) ) 
    178                    
    179                   !! adjust e_i ??? 
    180                   e_i_1d(ji,1:nlay_i) = e_i_1d(ji,1:nlay_i) * ( 1._wp + zda_tot(ji) / at_i_1d(ji) ) 
    181                   e_s_1d(ji,1)        = e_s_1d(ji,1)        * ( 1._wp + zda_tot(ji) / at_i_1d(ji) ) 
    182                    
    183                   ! new concentration 
    184                   a_i_1d(ji) = a_i_1d(ji) + zda 
    185                    
    186                   ! ensure that ht_i = 0 where a_i = 0 
    187                   IF( a_i_1d(ji) == 0._wp ) THEN 
    188                      ht_i_1d(ji) = 0._wp 
    189                      ht_s_1d(ji) = 0._wp 
    190                   ENDIF 
    191                ENDIF 
    192             END DO 
    193              
    194             CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d    (1:nidx), a_i (:,:,jl) ) 
    195             CALL tab_1d_2d( nidx, idxice(1:nidx), ht_i_1d   (1:nidx), ht_i(:,:,jl) ) 
    196             CALL tab_1d_2d( nidx, idxice(1:nidx), ht_s_1d   (1:nidx), ht_s(:,:,jl) ) 
    197             DO jk = 1, nlay_s 
    198                CALL tab_1d_2d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) ) 
    199             END DO 
    200             DO jk = 1, nlay_i 
    201                CALL tab_1d_2d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) ) 
    202             END DO 
    203              
    204          END DO 
    205           
    206          CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam ) 
    207          CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd ) 
    208          CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam ) 
    209           
    210       ENDIF 
    211151      ! 
    212152   END SUBROUTINE lim_thd_da 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r8369 r8370  
    2020   USE ice            ! LIM variables 
    2121   USE thd_ice        ! LIM thermodynamics 
     22   ! 
    2223   USE in_out_manager ! I/O manager 
    2324   USE lib_mpp        ! MPP library 
Note: See TracChangeset for help on using the changeset viewer.