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 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 – NEMO

Ignore:
Timestamp:
2015-05-12T12:37:15+02:00 (9 years ago)
Author:
deazer
Message:

Merged branch with Trunk at revision 5253.
Checked with SETTE, passes modified iodef.xml for AMM12 experiment

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4624 r5260  
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1414   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 
     15   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                     
    1516   !!---------------------------------------------------------------------- 
    1617 
     
    3738   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3839   USE sbccpl           ! surface boundary condition: coupled florulation 
    39    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    4040   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4141   USE sbcrnf           ! surface boundary condition: runoffs 
     42   USE sbcisf           ! surface boundary condition: ice shelf 
    4243   USE sbcfwb           ! surface boundary condition: freshwater budget 
    4344   USE closea           ! closed sea 
     
    8283      INTEGER ::   icpt   ! local integer 
    8384      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     85      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    8586         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    86          &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx 
     87         &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
    8788      INTEGER  ::   ios 
    8889      !!---------------------------------------------------------------------- 
     
    123124         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124125         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    125          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    126          WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx) 
     126         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     127         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    127128         WRITE(numout,*) '           Misc. options of sbc : ' 
    128129         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
     
    131132         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc  
    132133         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf 
     134         WRITE(numout,*) '              iceshelf formulation                       nn_isf      = ', nn_isf 
    133135         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr 
    134136         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb 
     
    137139      ENDIF 
    138140 
    139       !   Flux handling over ice categories 
    140 #if defined key_coupled  
    141       SELECT CASE ( TRIM (cn_iceflx)) 
    142       CASE ('ave') 
    143          ln_iceflx_ave    = .TRUE. 
    144          ln_iceflx_linear = .FALSE. 
    145       CASE ('linear') 
    146          ln_iceflx_ave    = .FALSE. 
    147          ln_iceflx_linear = .TRUE. 
    148       CASE default 
    149          ln_iceflx_ave    = .FALSE. 
    150          ln_iceflx_linear = .FALSE. 
     141      ! LIM3 Multi-category heat flux formulation 
     142      SELECT CASE ( nn_limflx) 
     143      CASE ( -1 ) 
     144         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) ' 
     145      CASE ( 0  ) 
     146         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) '  
     147      CASE ( 1  ) 
     148         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) ' 
     149      CASE ( 2  ) 
     150         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) ' 
    151151      END SELECT 
    152       IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave 
    153       IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 
    154 #endif 
    155152      ! 
    156153#if defined key_top && ! defined key_offline 
     
    180177         rnfmsk_z(:)   = 0.0_wp 
    181178      ENDIF 
     179      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf  
     180         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
     181         fwfisf  (:,:) = 0.0_wp 
     182         fwfisf_b(:,:) = 0.0_wp 
     183      END IF 
    182184      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
    183185 
     
    186188  
    187189      fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation 
     190       
     191      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart 
    188192 
    189193      !                                            ! restartability    
     
    206210      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    207211         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    208 #if defined key_coupled 
    209       IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 
    210          &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 
    211       IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 
    212          &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 
    213 #endif       
     212      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
     213         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
     214      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     215         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     216      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     217         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     218 
    214219      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    215220 
     
    236241      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    237242      icpt = 0 
    238       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    239       IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    240       IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    241       IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    242       IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    243       IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    244       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    245       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
     243      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
     244      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
     245      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
     246      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
     247      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
     248      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
     249      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
     250      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
    246251      ! 
    247252      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
     
    254259      IF(lwp) THEN 
    255260         WRITE(numout,*) 
    256          IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    257          IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation' 
    258          IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation' 
    259          IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation' 
    260          IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation' 
    261          IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation' 
    262          IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation' 
    263          IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    264       ENDIF 
    265       ! 
    266                           CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    267       ! 
    268       IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    269       ! 
    270       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    271       ! 
     261         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     262         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
     263         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
     264         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
     265         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
     266         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
     267         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
     268         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
     269      ENDIF 
     270      ! 
     271                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
     272      ! 
     273      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     274      ! 
     275      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation 
     276 
     277      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     278      ! 
     279      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
     280 
    272281   END SUBROUTINE sbc_init 
    273282 
     
    320329      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    321330      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    322       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    323       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    324       CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    325       CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    326       CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    327       CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
    328       CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    329       CASE( -1 )                                 
    330                        CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    331                        CALL sbc_gyre    ( kt )                    ! 
    332                        CALL sbc_flx     ( kt )                    ! 
    333                        CALL sbc_blk_clio( kt )                    ! 
    334                        CALL sbc_blk_core( kt )                    ! 
    335                        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
     331      CASE( jp_gyre )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
     332      CASE( jp_ana  )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     333      CASE( jp_flx  )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
     334      CASE( jp_clio )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
     335      CASE( jp_core )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     336      CASE( jp_cpl  )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     337      CASE( jp_mfs  )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     338      CASE( jp_esopa )                                 
     339                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     340                             CALL sbc_gyre    ( kt )                    ! 
     341                             CALL sbc_flx     ( kt )                    ! 
     342                             CALL sbc_blk_clio( kt )                    ! 
     343                             CALL sbc_blk_core( kt )                    ! 
     344                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
    336345      END SELECT 
    337346 
     
    342351      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    343352      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    344       !is it useful? 
    345353      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    346354      END SELECT                                               
    347355 
    348356      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs 
     357 
     358      IF( nn_isf   /= 0  )   CALL sbc_isf( kt )                    ! compute iceshelves 
    349359 
    350360      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
     
    414424         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    415425         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     426         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     427         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    416428      ENDIF 
    417429      ! 
    418430      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    419431      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice) 
    420       CALL iom_put( "taum", taum )   ! wind stress module  
    421       CALL iom_put( "wspd", wndm )   ! wind speed  module  
    422432      ! 
    423433      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    424          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    425          CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    426          CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask, ovlap=1 ) 
     434         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
     435         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
     436         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf  - : ', mask1=tmask, ovlap=1 ) 
    427437         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    428438         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
Note: See TracChangeset for help on using the changeset viewer.