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 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcmod.F90 – NEMO

Ignore:
Timestamp:
2021-05-05T13:18:04+02:00 (3 years ago)
Author:
mcastril
Message:

[2021/HPC-11_mcastril_HPDAonline_DiagGPU] Update externals

Location:
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
         5^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8^/vendors/PPR@HEAD            ext/PPR 
        89 
        910# SETTE 
        10 ^/utils/CI/sette@13559        sette 
         11^/utils/CI/sette@14244        sette 
  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcmod.F90

    r13722 r14789  
    1616   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
    1717   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
     18   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave forcing and coupling 
    1819   !!---------------------------------------------------------------------- 
    1920 
     
    2728   USE closea         ! closed seas 
    2829   USE phycst         ! physical constants 
     30   USE sbc_phy, ONLY : pp_cldf 
    2931   USE sbc_oce        ! Surface boundary condition: ocean fields 
    3032   USE trc_oce        ! shared ocean-passive tracers variables 
     
    4547   USE sbcssr         ! surface boundary condition: sea surface restoring 
    4648   USE sbcrnf         ! surface boundary condition: runoffs 
    47    USE sbcapr         ! surface boundary condition: atmo pressure  
     49   USE sbcapr         ! surface boundary condition: atmo pressure 
    4850   USE sbcfwb         ! surface boundary condition: freshwater budget 
    4951   USE icbstp         ! Icebergs 
     
    5456   USE usrdef_sbc     ! user defined: surface boundary condition 
    5557   USE closea         ! closed sea 
     58   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5659   ! 
    5760   USE prtctl         ! Print control                    (prt_ctl routine) 
     
    7073 
    7174   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    72  
     75   !! * Substitutions 
     76#  include "do_loop_substitute.h90" 
    7377   !!---------------------------------------------------------------------- 
    7478   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    99103         &             nn_ice   , ln_ice_embd,                                       & 
    100104         &             ln_traqsr, ln_dm2dc ,                                         & 
    101          &             ln_rnf   , nn_fwb   , ln_ssr   , ln_apr_dyn,                  & 
    102          &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc , ln_stcor  ,      & 
    103          &             ln_tauw  , nn_lsm, nn_sdrift 
     105         &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,                & 
     106         &             ln_wave  , nn_lsm 
    104107      !!---------------------------------------------------------------------- 
    105108      ! 
     
    117120      IF(lwm) WRITE( numond, namsbc ) 
    118121      ! 
    119 #if defined key_mpp_mpi 
     122#if ! defined key_mpi_off 
    120123      ncom_fsbc = nn_fsbc    ! make nn_fsbc available for lib_mpp 
    121124#endif 
     
    133136         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk 
    134137         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl 
     138         WRITE(numout,*) '         Surface wave (forced or coupled)           ln_wave       = ', ln_wave 
    135139         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
    136140         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    137141         WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl 
    138 !!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist  
     142!!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist 
    139143         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
    140144         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components 
     
    150154         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
    151155         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    152          WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave 
    153          WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw 
    154          WRITE(numout,*) '                  vertical parametrization          nn_sdrift     = ', nn_sdrift 
    155          WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc     = ', ln_tauwoc 
    156          WRITE(numout,*) '               wave modified ocean stress component ln_tauw       = ', ln_tauw 
    157          WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor 
    158          WRITE(numout,*) '               neutral drag coefficient (CORE,NCAR) ln_cdgw       = ', ln_cdgw 
    159       ENDIF 
    160       ! 
    161       IF( .NOT.ln_wave ) THEN 
    162          ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 
    163       ENDIF  
    164       IF( ln_sdw ) THEN 
    165          IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & 
    166             CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' ) 
    167       ENDIF 
    168       ll_st_bv2014  = ( nn_sdrift==jp_breivik_2014 ) 
    169       ll_st_li2017  = ( nn_sdrift==jp_li_2017 ) 
    170       ll_st_bv_li   = ( ll_st_bv2014 .OR. ll_st_li2017 ) 
    171       ll_st_peakfr  = ( nn_sdrift==jp_peakfr ) 
    172       IF( ln_tauwoc .AND. ln_tauw ) & 
    173          CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 
    174                                   '(ln_tauwoc=.true. and ln_tauw=.true.)' ) 
    175       IF( ln_tauwoc ) & 
    176          CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' ) 
    177       IF( ln_tauw ) & 
    178          CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', & 
    179                               'This will override any other specification of the ocean stress' ) 
     156      ENDIF 
    180157      ! 
    181158      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case) 
     
    186163      !                       !**  check option consistency 
    187164      ! 
    188       IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS)  
     165      IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OCE+SAS) 
    189166      SELECT CASE( nn_components ) 
    190167      CASE( jp_iam_nemo ) 
    191          IF(lwp) WRITE(numout,*) '   ==>>>   NEMO configured as a single executable (i.e. including both OPA and Surface module)' 
    192       CASE( jp_iam_opa  ) 
    193          IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, OPA component' 
    194          IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
    195          IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA'   ) 
    196          IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     168         IF(lwp) WRITE(numout,*) '   ==>>>   NEMO configured as a single executable (i.e. including both OCE and Surface module)' 
     169      CASE( jp_iam_oce  ) 
     170         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, OCE component' 
     171         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     172         IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_cpl = T in OCE'   ) 
     173         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 
    197174      CASE( jp_iam_sas  ) 
    198175         IF(lwp) WRITE(numout,*) '   ==>>>   Multi executable configuration. Here, SAS component' 
    199          IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
    200          IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     176         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     177         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 
    201178      CASE DEFAULT 
    202179         CALL ctl_stop( 'sbc_init : unsupported value for nn_components' ) 
     
    218195      SELECT CASE( nn_ice ) 
    219196      CASE( 0 )                        !- no ice in the domain 
    220       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
     197      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model) 
    221198      CASE( 2 )                        !- SI3  ice model 
    222199         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   & 
     
    226203            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 
    227204         IF( lk_agrif                                )   & 
    228             &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )  
     205            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
    229206      CASE DEFAULT                     !- not supported 
    230207      END SELECT 
     
    241218      ! 
    242219      IF( sbc_ssr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 
    243       IF( .NOT.ln_ssr ) THEN               !* Initialize qrp and erp if no restoring  
     220      IF( .NOT.ln_ssr ) THEN               !* Initialize qrp and erp if no restoring 
    244221         qrp(:,:) = 0._wp 
    245222         erp(:,:) = 0._wp 
     
    247224      ! 
    248225      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero 
    249          IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case 
     226         IF( nn_components /= jp_iam_oce )   fr_i(:,:) = 0._wp    ! except for OCE in SAS-OCE coupled case 
    250227      ENDIF 
    251228      ! 
     
    260237      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle 
    261238         !LB:nday_qsr = -1   ! allow initialization at the 1st call 
    262          IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   & 
     239         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_oce )   & 
    263240            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 
    264241      ENDIF 
     
    267244      ! 
    268245      ll_purecpl  = ln_cpl .AND. .NOT.ln_mixcpl 
    269       ll_opa      = nn_components == jp_iam_opa 
     246      ll_opa      = nn_components == jp_iam_oce 
    270247      ll_not_nemo = nn_components /= jp_iam_nemo 
    271248      icpt = 0 
     
    289266         CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation' 
    290267!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter 
    291          CASE( jp_none    )   ;   WRITE(numout,*) '   ==>>>   OPA coupled to SAS via oasis' 
     268         CASE( jp_none    )   ;   WRITE(numout,*) '   ==>>>   OCE coupled to SAS via oasis' 
    292269            IF( ln_mixcpl )       WRITE(numout,*) '               + forced-coupled mixed formulation' 
    293270         END SELECT 
     
    299276      IF( lk_oasis )   CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step 
    300277      !                                              !                      (2) the use of nn_fsbc 
    301       !     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     278      !     nn_fsbc initialization if OCE-SAS coupling via OASIS 
    302279      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
    303280      IF( nn_components /= jp_iam_nemo ) THEN 
    304          IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 
     281         IF( nn_components == jp_iam_oce )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 
    305282         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt) 
    306283         ! 
    307284         IF(lwp)THEN 
    308285            WRITE(numout,*) 
    309             WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     286            WRITE(numout,*)"   OCE-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
    310287            WRITE(numout,*) 
    311288         ENDIF 
     
    330307         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    331308      ! 
    332     
     309 
    333310      !                       !**  associated modules : initialization 
    334311      ! 
     
    357334      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization 
    358335      ! 
    359       IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation 
    360       ! 
    361       IF( lwxios ) THEN 
    362          CALL iom_set_rstw_var_active('utau_b') 
    363          CALL iom_set_rstw_var_active('vtau_b') 
    364          CALL iom_set_rstw_var_active('qns_b') 
    365          ! The 3D heat content due to qsr forcing is treated in traqsr 
    366          ! CALL iom_set_rstw_var_active('qsr_b') 
    367          CALL iom_set_rstw_var_active('emp_b') 
    368          CALL iom_set_rstw_var_active('sfx_b') 
    369       ENDIF 
    370  
     336      IF( ln_wave     ) THEN 
     337                          CALL sbc_wave_init                     ! surface wave initialisation 
     338      ELSE 
     339                          IF(lwp) WRITE(numout,*) 
     340                          IF(lwp) WRITE(numout,*) '   No surface waves : all wave related logical set to false' 
     341                          ln_sdw       = .false. 
     342                          ln_stcor     = .false. 
     343                          ln_cdgw      = .false. 
     344                          ln_tauoc     = .false. 
     345                          ln_wave_test = .false. 
     346                          ln_charn     = .false. 
     347                          ln_taw       = .false. 
     348                          ln_phioc     = .false. 
     349                          ln_bern_srfc = .false. 
     350                          ln_breivikFV_2016 = .false. 
     351                          ln_vortex_force = .false. 
     352                          ln_stshear  = .false. 
     353      ENDIF 
     354      ! 
    371355   END SUBROUTINE sbc_init 
    372356 
     
    390374      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    391375      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     376      INTEGER  ::   jj, ji          ! dummy loop argument 
    392377      ! 
    393378      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    394379      ! 
    395380      REAL(wp) ::     zthscl        ! wd  tanh scale 
    396       REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt   
     381      REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt 
    397382 
    398383      !!--------------------------------------------------------------------- 
     
    419404      ! 
    420405      ll_sas = nn_components == jp_iam_sas               ! component flags 
    421       ll_opa = nn_components == jp_iam_opa 
     406      ll_opa = nn_components == jp_iam_oce 
    422407      ! 
    423408      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    424       IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves 
    425  
    426409      ! 
    427410      !                                            !==  sbc formulation  ==! 
    428       !                                                    
     411      ! 
     412      ! 
    429413      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    430414      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    431       CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation  
     415      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation 
    432416      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation 
    433417      CASE( jp_blk     ) 
    434          IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     418         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OCE-SAS coupling: SAS receiving fields from OCE 
     419!!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     420         IF( ln_wave )   THEN 
     421             IF ( lk_oasis )  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OCE-wave coupling 
     422             CALL sbc_wave ( kt, Kmm ) 
     423         ENDIF 
    435424                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean 
    436425                               ! 
    437426      CASE( jp_abl     ) 
    438          IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     427         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OCE-SAS coupling: SAS receiving fields from OCE 
    439428                               CALL sbc_abl       ( kt )                    ! ABL  formulation for the ocean 
    440429                               ! 
    441430      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! pure coupled formulation 
    442431      CASE( jp_none    ) 
    443          IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS 
     432         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OCE-SAS coupling: OCE receiving fields from SAS 
    444433      END SELECT 
    445434      ! 
    446435      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing 
    447436      ! 
    448       IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves  
     437      IF( ln_wave .AND. ln_tauoc )  THEN            ! Wave stress reduction 
     438         DO_2D( 0, 0, 0, 0) 
     439            utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji-1,jj) ) * 0.5_wp 
     440            vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj-1) ) * 0.5_wp 
     441         END_2D 
     442         ! 
     443         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     444         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     445         ! 
     446         taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
     447         ! 
     448         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     449            &                                'If not requested select ln_tauoc=.false.' ) 
     450         ! 
     451      ELSEIF( ln_wave .AND. ln_taw ) THEN                  ! Wave stress reduction 
     452         utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 
     453         vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 
     454         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     455         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     456         ! 
     457         DO_2D( 0, 0, 0, 0) 
     458             taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2) 
     459         END_2D 
     460         ! 
     461         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     462            &                                'If not requested select ln_taw=.false.' ) 
     463         ! 
     464      ENDIF 
     465      CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 
    449466      ! 
    450467      !                                            !==  Misc. Options  ==! 
     
    459476 
    460477      IF( ln_icebergs    )   THEN 
    461                                      CALL icb_stp( kt )           ! compute icebergs 
    462          ! Icebergs do not melt over the haloes.  
    463          ! So emp values over the haloes are no more consistent with the inner domain values.  
     478                                     CALL icb_stp( kt, Kmm )           ! compute icebergs 
     479         ! Icebergs do not melt over the haloes. 
     480         ! So emp values over the haloes are no more consistent with the inner domain values. 
    464481         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 
    465482         ! see ticket #2113 for discussion about this lbc_lnk. 
     
    475492      ! Special treatment of freshwater fluxes over closed seas in the model domain 
    476493      ! Should not be run if ln_diurnal_only 
    477       IF( l_sbc_clo      )   CALL sbc_clo( kt )    
     494      IF( l_sbc_clo      )   CALL sbc_clo( kt ) 
    478495 
    479496!!$!RBbug do not understand why see ticket 667 
     
    481498!!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 
    482499      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    483          zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  
     500         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
    484501         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
    485502                                                     ! depth above wd limit once 
     
    507524      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    508525         !                                             ! ---------------------------------------- ! 
    509          IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    510             & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    511             IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    512             CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b, ldxios = lrxios, cd_type = 'U', psgn = -1._wp )   ! before i-stress  (U-point) 
    513             CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b, ldxios = lrxios, cd_type = 'V', psgn = -1._wp )   ! before j-stress  (V-point) 
    514             CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point) 
    515             ! The 3D heat content due to qsr forcing is treated in traqsr 
    516             ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point) 
    517             CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b, ldxios = lrxios  )    ! before     freshwater flux (T-point) 
     526         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN            !* Restart: read in restart file 
     527            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields read in the restart file' 
     528            CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b )   ! i-stress 
     529            CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b )   ! j-stress 
     530            CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b )   ! non solar heat flux 
     531            CALL iom_get( numror, jpdom_auto,  'emp_b',  emp_b )   ! freshwater flux 
     532            ! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr 
    518533            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
    519534            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
    520                CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b, ldxios = lrxios )  ! before salt flux (T-point) 
     535               CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
    521536            ELSE 
    522537               sfx_b (:,:) = sfx(:,:) 
     
    538553            &                    'at it= ', kt,' date= ', ndastp 
    539554         IF(lwp) WRITE(numout,*) '~~~~' 
    540          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    541          CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios ) 
    542          CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios ) 
    543          CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns, ldxios = lwxios  ) 
     555         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 
     556         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 
     557         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  ) 
    544558         ! The 3D heat content due to qsr forcing is treated in traqsr 
    545559         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    546          CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp, ldxios = lwxios  ) 
    547          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx, ldxios = lwxios  ) 
    548          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
     560         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
     561         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  ) 
    549562      ENDIF 
    550563      !                                                ! ---------------------------------------- ! 
     
    552565      !                                                ! ---------------------------------------- ! 
    553566      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    554          CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux 
    555          CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
    556          CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
    557          CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux 
    558          CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux 
    559          CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    560          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
     567         CALL iom_put( "empmr"  , emp   - rnf )                ! upward water flux 
     568         CALL iom_put( "empbmr" , emp_b - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
     569         CALL iom_put( "saltflx", sfx         )                ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
     570         CALL iom_put( "fmmflx" , fmmflx      )                ! Freezing-melting water flux 
     571         CALL iom_put( "qt"     , qns + qsr   )                ! total heat flux 
     572         CALL iom_put( "qns"    , qns         )                ! solar heat flux 
     573         CALL iom_put( "qsr"    ,       qsr   )                ! solar heat flux 
    561574         IF( nn_ice > 0 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
    562          CALL iom_put( "taum"  , taum       )                   ! wind stress module 
    563          CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    564          CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    565          CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     575         CALL iom_put( "taum"   , taum        )                ! wind stress module 
     576         CALL iom_put( "wspd"   , wndm        )                ! wind speed  module over free ocean or leads in presence of sea-ice 
     577         CALL iom_put( "qrp"    , qrp         )                ! heat flux damping 
     578         CALL iom_put( "erp"    , erp         )                ! freshwater flux damping 
    566579      ENDIF 
    567580      ! 
    568581      IF(sn_cfctl%l_prtctl) THEN     ! print mean trends (used for debugging) 
    569          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask ) 
    570          CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
    571          CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
    572          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask ) 
    573          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask ) 
    574          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
     582         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i     - : ', mask1=tmask ) 
     583         CALL prt_ctl(tab2d_1=(emp-rnf)           , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
     584         CALL prt_ctl(tab2d_1=(sfx-rnf)           , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
     585         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask ) 
     586         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
     587         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    575588         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    576589         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
Note: See TracChangeset for help on using the changeset viewer.