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 13655 for NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icesbc.F90 – NEMO

Ignore:
Timestamp:
2020-10-21T16:15:13+02:00 (4 years ago)
Author:
laurent
Message:

Commit all my dev of 2020!

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icesbc.F90

    r13472 r13655  
    5959      !! 
    6060      INTEGER  ::   ji, jj                 ! dummy loop index 
    61       REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice  
     61      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice 
    6262      !!------------------------------------------------------------------- 
    6363      ! 
     
    7171      ! 
    7272      SELECT CASE( ksbc ) 
    73          CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    74          CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
    75             &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   & 
     73         ! 
     74      CASE( jp_usr     ) 
     75         CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
     76         ! 
     77      CASE( jp_blk     ) 
     78         CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
     79            &                                      theta_air_zt(:,:), q_air_zt(:,:),   &   ! #LB: known from "sbc_oce" module... 
    7680            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs 
    77             &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                              
    78  !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
    79          CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
     81            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs 
     82         !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
     83      CASE( jp_purecpl ) 
     84         CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
    8085      END SELECT 
    8186      ! 
    8287      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    83                                    CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     88         CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    8489         DO_2D( 0, 0, 0, 0 ) 
    85             utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    86             vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     90         utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     91         vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8792         END_2D 
    8893         CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
     
    9398   END SUBROUTINE ice_sbc_tau 
    9499 
    95     
     100 
    96101   SUBROUTINE ice_sbc_flx( kt, ksbc ) 
    97102      !!------------------------------------------------------------------- 
     
    108113      !!                dqns_ice                                 = non solar  heat sensistivity                  [W/m2] 
    109114      !!                qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2] 
    110       !!            + some fields that are not used outside this module:  
     115      !!            + some fields that are not used outside this module: 
    111116      !!                qla_ice                                  = latent heat flux over ice                     [W/m2] 
    112117      !!                dqla_ice                                 = latent heat sensistivity                      [W/m2] 
     
    118123      ! 
    119124      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    120       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
     125      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
    121126      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    122127      !!-------------------------------------------------------------------- 
     
    138143      ! 
    139144      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
    140       ! 
     145         ! 
    141146      CASE( jp_usr )              !--- user defined formulation 
    142                                   CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
     147         CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
     148         ! 
    143149      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
    144                                   CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    & 
    145             &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    !  
     150         CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, & 
     151            &                theta_air_zt(:,:), q_air_zt(:,:),    &   ! #LB: known from "sbc_oce" module... 
     152            &                sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), & 
     153            &                sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) 
     154         ! 
    146155         IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    147156         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
     
    150159            &                     CALL blk_ice_qcn    ( ln_virtual_itd, t_su, t_bo, h_s, h_i ) 
    151160      CASE ( jp_purecpl )         !--- coupled formulation 
    152                                   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
     161         CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    153162         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
    154163      END SELECT 
     
    163172            zalb  (:,:) = rn_alb_oce 
    164173         ELSEWHERE 
    165             zmsk00(:,:) = 1._wp             
     174            zmsk00(:,:) = 1._wp 
    166175            zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    167176         END WHERE 
     
    185194      !!                  ***  ROUTINE ice_flx_dist  *** 
    186195      !! 
    187       !! ** Purpose :   update the ice surface boundary condition by averaging  
     196      !! ** Purpose :   update the ice surface boundary condition by averaging 
    188197      !!              and/or redistributing fluxes on ice categories 
    189198      !! 
     
    192201      !! ** Action  :   depends on k_flxdist 
    193202      !!                = -1  Do nothing (needs N(cat) fluxes) 
    194       !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice  
     203      !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice 
    195204      !!                =  1  Average N(cat) fluxes then redistribute over the N(cat) ice 
    196205      !!                                                 using T-ice and albedo sensitivity 
     
    219228      !!---------------------------------------------------------------------- 
    220229      ! 
    221       WHERE ( at_i (:,:) > 0._wp )   ; z1_at_i(:,:) = 1._wp / at_i (:,:) 
    222       ELSEWHERE                      ; z1_at_i(:,:) = 0._wp 
     230      WHERE ( at_i (:,:) > 0._wp ) 
     231         z1_at_i(:,:) = 1._wp / at_i (:,:) 
     232      ELSEWHERE 
     233         z1_at_i(:,:) = 0._wp 
    223234      END WHERE 
    224        
     235 
    225236      SELECT CASE( k_flxdist )       !==  averaged on all ice categories  ==! 
    226       ! 
     237         ! 
    227238      CASE( 0 , 1 ) 
    228239         ! 
    229          ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )   
     240         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) ) 
    230241         ! 
    231242         z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
     
    242253         END DO 
    243254         ! 
    244          DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )   
     255         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m ) 
    245256         ! 
    246257      END SELECT 
    247258      ! 
    248259      SELECT CASE( k_flxdist )       !==  redistribution on all ice categories  ==! 
    249       ! 
     260         ! 
    250261      CASE( 1 , 2 ) 
    251262         ! 
    252          ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )   
     263         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) ) 
    253264         ! 
    254265         zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:) 
     
    260271         END DO 
    261272         ! 
    262          DEALLOCATE( zalb_m, ztem_m )   
     273         DEALLOCATE( zalb_m, ztem_m ) 
    263274         ! 
    264275      END SELECT 
     
    272283      !! 
    273284      !! ** Purpose :   Physical constants and parameters linked to the ice dynamics 
    274       !!       
     285      !! 
    275286      !! ** Method  :   Read the namsbc namelist and check the ice-dynamic 
    276287      !!              parameter values called at the first timestep (nit000) 
Note: See TracChangeset for help on using the changeset viewer.