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

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

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

    r4624 r6225  
    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 
    1718   !!---------------------------------------------------------------------- 
    18    !!   sbc_init       : read namsbc namelist 
    19    !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions 
     19   !!   sbc_init      : read namsbc namelist 
     20   !!   sbc           : surface ocean momentum, heat and freshwater boundary conditions 
    2021   !!---------------------------------------------------------------------- 
    21    USE oce              ! ocean dynamics and tracers 
    22    USE dom_oce          ! ocean space and time domain 
    23    USE phycst           ! physical constants 
    24    USE sbc_oce          ! Surface boundary condition: ocean fields 
    25    USE sbc_ice          ! Surface boundary condition: ice fields 
    26    USE sbcdcy           ! surface boundary condition: diurnal cycle 
    27    USE sbcssm           ! surface boundary condition: sea-surface mean variables 
    28    USE sbcapr           ! surface boundary condition: atmospheric pressure 
    29    USE sbcana           ! surface boundary condition: analytical formulation 
    30    USE sbcflx           ! surface boundary condition: flux formulation 
    31    USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO 
    32    USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE 
    33    USE sbcblk_mfs       ! surface boundary condition: bulk formulation : MFS 
    34    USE sbcice_if        ! surface boundary condition: ice-if sea-ice model 
    35    USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model 
    36    USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model 
    37    USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    38    USE sbccpl           ! surface boundary condition: coupled florulation 
    39    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    40    USE sbcssr           ! surface boundary condition: sea surface restoring 
    41    USE sbcrnf           ! surface boundary condition: runoffs 
    42    USE sbcfwb           ! surface boundary condition: freshwater budget 
    43    USE closea           ! closed sea 
    44    USE icbstp           ! Icebergs! 
    45  
    46    USE prtctl           ! Print control                    (prt_ctl routine) 
    47    USE iom              ! IOM library 
    48    USE in_out_manager   ! I/O manager 
    49    USE lib_mpp          ! MPP library 
    50    USE timing           ! Timing 
    51    USE sbcwave          ! Wave module 
     22   USE oce            ! ocean dynamics and tracers 
     23   USE dom_oce        ! ocean space and time domain 
     24   USE phycst         ! physical constants 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
     26   USE trc_oce        ! shared ocean-passive tracers variables 
     27   USE sbc_ice        ! Surface boundary condition: ice fields 
     28   USE sbcdcy         ! surface boundary condition: diurnal cycle 
     29   USE sbcssm         ! surface boundary condition: sea-surface mean variables 
     30   USE sbcana         ! surface boundary condition: analytical formulation 
     31   USE sbcflx         ! surface boundary condition: flux formulation 
     32   USE sbcblk_clio    ! surface boundary condition: bulk formulation : CLIO 
     33   USE sbcblk_core    ! surface boundary condition: bulk formulation : CORE 
     34   USE sbcblk_mfs     ! surface boundary condition: bulk formulation : MFS 
     35   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model 
     36   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model 
     37   USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model 
     38   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model 
     39   USE sbccpl         ! surface boundary condition: coupled florulation 
     40   USE cpl_oasis3     ! OASIS routines for coupling 
     41   USE sbcssr         ! surface boundary condition: sea surface restoring 
     42   USE sbcrnf         ! surface boundary condition: runoffs 
     43   USE sbcisf         ! surface boundary condition: ice shelf 
     44   USE sbcfwb         ! surface boundary condition: freshwater budget 
     45   USE closea         ! closed sea 
     46   USE icbstp         ! Icebergs 
     47   USE traqsr         ! active tracers: light penetration 
     48   USE sbcwave        ! Wave module 
     49   USE bdy_par        ! Require lk_bdy 
     50   ! 
     51   USE prtctl         ! Print control                    (prt_ctl routine) 
     52   USE iom            ! IOM library 
     53   USE in_out_manager ! I/O manager 
     54   USE lib_mpp        ! MPP library 
     55   USE timing         ! Timing 
     56 
     57   USE diurnal_bulk, ONLY: & 
     58      & ln_diurnal_only  
    5259 
    5360   IMPLICIT NONE 
     
    5966   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    6067       
    61    !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6368   !!---------------------------------------------------------------------- 
    6469   !! NEMO/OPA 4.0 , NEMO-consortium (2011)  
     
    8287      INTEGER ::   icpt   ! local integer 
    8388      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
    85          &             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 
     89      NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs,   & 
     90         &             ln_cpl   , ln_mixcpl, nn_components      , nn_limflx  ,               & 
     91         &             ln_traqsr, ln_dm2dc ,                                                 &   
     92         &             nn_ice   , nn_ice_embd,                                               & 
     93         &             ln_rnf   , ln_ssr   , ln_isf   , nn_fwb    , ln_apr_dyn,              & 
     94         &             ln_wave  ,                                                            & 
     95         &             nn_lsm    
    8796      INTEGER  ::   ios 
     97      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
     98      LOGICAL  ::   ll_purecpl 
    8899      !!---------------------------------------------------------------------- 
    89  
     100      ! 
    90101      IF(lwp) THEN 
    91102         WRITE(numout,*) 
     
    93104         WRITE(numout,*) '~~~~~~~~ ' 
    94105      ENDIF 
    95  
     106      ! 
    96107      REWIND( numnam_ref )              ! Namelist namsbc in reference namelist : Surface boundary 
    97108      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 
    98 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
    99  
     109901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
     110      ! 
    100111      REWIND( numnam_cfg )              ! Namelist namsbc in configuration namelist : Parameters of the run 
    101112      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    102 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    103       IF(lwm) WRITE ( numond, namsbc ) 
    104  
     113902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
     114      IF(lwm) WRITE( numond, namsbc ) 
     115      ! 
    105116      !                          ! overwrite namelist parameter using CPP key information 
    106117      IF( Agrif_Root() ) THEN                ! AGRIF zoom 
     
    113124          nn_ice      =   0 
    114125      ENDIF 
    115       
     126      ! 
    116127      IF(lwp) THEN               ! Control print 
    117128         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    118129         WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc 
    119          WRITE(numout,*) '           Type of sbc : ' 
    120          WRITE(numout,*) '              analytical formulation                     ln_ana      = ', ln_ana 
    121          WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx 
    122          WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio 
    123          WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124          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) 
     130         WRITE(numout,*) '           Type of air-sea fluxes : ' 
     131         WRITE(numout,*) '              analytical formulation                     ln_ana        = ', ln_ana 
     132         WRITE(numout,*) '              flux       formulation                     ln_flx        = ', ln_flx 
     133         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio   = ', ln_blk_clio 
     134         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core   = ', ln_blk_core 
     135         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs    = ', ln_blk_mfs 
     136         WRITE(numout,*) '           Type of coupling (Ocean/Ice/Atmosphere) : ' 
     137         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
     138         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl     = ', ln_mixcpl 
     139         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
     140         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
     141         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
     142         WRITE(numout,*) '           Sea-ice : ' 
     143         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice  
     144         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
    127145         WRITE(numout,*) '           Misc. options of sbc : ' 
    128          WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    129          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice  
    130          WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd 
    131          WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc  
    132          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf 
    133          WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr 
    134          WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb 
    135          WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea 
    136          WRITE(numout,*) '              n. of iterations if land-sea-mask applied  nn_lsm      = ', nn_lsm 
    137       ENDIF 
    138  
    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. 
    151       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 
    155       ! 
    156 #if defined key_top && ! defined key_offline 
    157       ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2) 
    158       IF( ltrcdm2dc )THEN 
    159          IF(lwp)THEN 
    160             WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: " 
    161             WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers" 
    162          ENDIF 
    163       ENDIF 
    164 #else  
    165       ltrcdm2dc =  .FALSE. 
    166 #endif 
    167  
    168       ! 
     146         WRITE(numout,*) '              Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
     147         WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc  
     148         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
     149         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
     150         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn 
     151         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
     152         WRITE(numout,*) '              iceshelf formulation                       ln_isf        = ', ln_isf 
     153         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
     154         WRITE(numout,*) '              nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
     155         WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave   
     156      ENDIF 
     157      ! 
     158      IF(lwp) THEN 
     159         WRITE(numout,*) 
     160         SELECT CASE ( nn_limflx )        ! LIM3 Multi-category heat flux formulation 
     161         CASE ( -1 )   ;   WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
     162         CASE ( 0  )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '  
     163         CASE ( 1  )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
     164         CASE ( 2  )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
     165         END SELECT 
     166      ENDIF 
     167      ! 
     168      IF( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
     169         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     170      IF( nn_components == jp_iam_opa .AND. ln_cpl )   & 
     171         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
     172      IF( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
     173         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     174      IF( ln_cpl .AND. .NOT. lk_oasis )    & 
     175         &      CALL ctl_stop( 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
     176      IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
     177         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
     178      IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
     179         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
     180      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
     181         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     182 
    169183      !                              ! allocate sbc arrays 
    170       IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
     184      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' ) 
    171185 
    172186      !                          ! Checks: 
    173       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
    174          ln_rnf_mouth  = .false.                       
    175          IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 
    176          nkrnf         = 0 
    177          rnf     (:,:) = 0.0_wp 
    178          rnf_b   (:,:) = 0.0_wp 
    179          rnfmsk  (:,:) = 0.0_wp 
    180          rnfmsk_z(:)   = 0.0_wp 
    181       ENDIF 
    182       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
    183  
    184       sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
     187      IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no ice shelf  
     188         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
     189         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp 
     190         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp 
     191      END IF 
     192      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! no ice in the domain, ice fraction is always zero 
     193 
     194      sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
    185195                                                   ! only if sea-ice is present 
    186196  
    187       fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation 
     197      fmmflx(:,:) = 0._wp                          ! freezing-melting array initialisation 
     198       
     199      taum(:,:) = 0._wp                            ! Initialise taum for use in gls in case of reduced restart 
    188200 
    189201      !                                            ! restartability    
     202      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
     203         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
     204      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
     205         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
     206      IF( nn_ice == 4 .AND. lk_agrif )   & 
     207         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
     208      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
     209         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
     210      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
     211         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
     212      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     213         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     214      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     215         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     216 
     217      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
     218 
     219      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
     220         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
     221       
     222      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     223      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     224      ! 
     225      icpt = 0 
     226      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     227      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
     228      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
     229      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
     230      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     231      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
     232      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
     233      IF( nn_components == jp_iam_opa )   & 
     234         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     235      ! 
     236      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init: choose ONE and only ONE sbc option' ) 
     237      ! 
     238      IF(lwp) THEN 
     239         WRITE(numout,*) 
     240         SELECT CASE( nsbc ) 
     241         CASE( jp_gyre    )   ;   WRITE(numout,*) '   GYRE analytical formulation' 
     242         CASE( jp_ana     )   ;   WRITE(numout,*) '   analytical formulation' 
     243         CASE( jp_flx     )   ;   WRITE(numout,*) '   flux formulation' 
     244         CASE( jp_clio    )   ;   WRITE(numout,*) '   CLIO bulk formulation' 
     245         CASE( jp_core    )   ;   WRITE(numout,*) '   CORE bulk formulation' 
     246         CASE( jp_purecpl )   ;   WRITE(numout,*) '   pure coupled formulation' 
     247         CASE( jp_mfs     )   ;   WRITE(numout,*) '   MFS Bulk formulation' 
     248         CASE( jp_none    )   ;   WRITE(numout,*) '   OPA coupled to SAS via oasis' 
     249            IF( ln_mixcpl )       WRITE(numout,*) '       + forced-coupled mixed formulation' 
     250         END SELECT 
     251         IF( nn_components/= jp_iam_nemo )  & 
     252            &                     WRITE(numout,*) '       + OASIS coupled SAS' 
     253      ENDIF 
     254      ! 
     255      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     256      !                                             !                                            (2) the use of nn_fsbc 
     257      !     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     258      !     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     259      IF( nn_components /= jp_iam_nemo ) THEN 
     260         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
     261         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     262         ! 
     263         IF(lwp)THEN 
     264            WRITE(numout,*) 
     265            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     266            WRITE(numout,*) 
     267         ENDIF 
     268      ENDIF 
     269      ! 
    190270      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    191271          MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     
    198278         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    199279      ! 
    200       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
    201          &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    202       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    203          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
    204       IF( nn_ice == 4 .AND. lk_agrif )   & 
    205          &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
    206       IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    207          &   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       
    214       IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    215  
    216       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
    217          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    218        
    219280      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    220281         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    221  
    222       IF ( ln_wave ) THEN 
    223       !Activated wave module but neither drag nor stokes drift activated 
    224          IF ( .NOT.(ln_cdgw .OR. ln_sdw) )   THEN 
    225             CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' ) 
    226       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
    227          ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )       THEN        
    228              CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 
    229          ENDIF 
    230       ELSE 
    231       IF ( ln_cdgw .OR. ln_sdw  )                                         &  
    232          &   CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but     & 
    233          & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 
    234       ENDIF  
    235        
    236       !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    237       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 
    246       ! 
    247       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    248          WRITE(numout,*) 
    249          WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option ' 
    250          WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)' 
    251          WRITE(numout,*) '                     We stop' 
    252          nstop = nstop + 1 
    253       ENDIF 
    254       IF(lwp) THEN 
    255          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 
    265282      ! 
    266283                          CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    267284      ! 
    268285      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     286      ! 
     287                          CALL sbc_rnf_init               ! Runof initialisation 
     288      ! 
     289      IF( nn_ice == 3 )   CALL sbc_lim_init               ! LIM3 initialisation 
    269290      ! 
    270291      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     
    300321         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields 
    301322         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine) 
    302          ! The 3D heat content due to qsr forcing is treated in traqsr 
    303          ! qsr_b (:,:) = qsr (:,:) 
    304          emp_b(:,:) = emp(:,:) 
    305          sfx_b(:,:) = sfx(:,:) 
     323         emp_b (:,:) = emp (:,:) 
     324         sfx_b (:,:) = sfx (:,:) 
    306325      ENDIF 
    307326      !                                            ! ---------------------------------------- ! 
     
    309328      !                                            ! ---------------------------------------- ! 
    310329      ! 
    311       IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
    312                                                          ! (caution called before sbc_ssm) 
    313       ! 
    314       CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    315       !                                                  ! averaged over nf_sbc time-step 
    316  
    317       IF (ln_wave) CALL sbc_wave( kt ) 
     330      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm ( kt )  ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     331      !                                                        ! averaged over nf_sbc time-step 
     332      IF( ln_wave                     )   CALL sbc_wave( kt )  ! surface waves 
     333       
     334       
    318335                                                   !==  sbc formulation  ==! 
    319336                                                             
    320337      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    321338      !                                                  ! (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 )   ! 
     339      CASE( jp_gyre  )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
     340      CASE( jp_ana   )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     341      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
     342      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
     343      CASE( jp_core  )    
     344         IF( nn_components == jp_iam_sas ) & 
     345            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
     346                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     347                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     348      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     349                                                                        ! 
     350      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     351      CASE( jp_none  )  
     352         IF( nn_components == jp_iam_opa )   & 
     353            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    336354      END SELECT 
    337355 
     356      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     357 
     358      ! 
    338359      !                                            !==  Misc. Options  ==! 
    339        
     360      ! 
    340361      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas 
    341362      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model) 
    342363      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    343364      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    344       !is it useful? 
    345365      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    346366      END SELECT                                               
    347367 
    348368      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs 
     369 
     370      IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves 
    349371 
    350372      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
     
    354376      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
    355377 
    356       IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain  
    357       !                                                           ! (update freshwater fluxes) 
     378      ! treatment of closed sea in the model domain  
     379      ! (update freshwater fluxes) 
     380      ! Should not be ran if ln_diurnal_only 
     381      IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt )    
     382 
    358383!RBbug do not understand why see ticket 667 
    359       !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 
     384!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
     385      CALL lbc_lnk( emp, 'T', 1. ) 
    360386      ! 
    361387      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
     
    398424         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    399425         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    400          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
    401       ENDIF 
    402  
     426         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  ) 
     427      ENDIF 
    403428      !                                                ! ---------------------------------------- ! 
    404429      !                                                !        Outputs and control print         ! 
     
    413438         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    414439         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    415          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     440         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     441         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     442         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    416443      ENDIF 
    417444      ! 
    418445      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    419446      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  
    422447      ! 
    423448      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 ) 
     449         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
     450         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 ) 
     451         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 ) 
    427452         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    428453         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
Note: See TracChangeset for help on using the changeset viewer.