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 7792 for branches – NEMO

Changeset 7792 for branches


Ignore:
Timestamp:
2017-03-14T16:47:48+01:00 (7 years ago)
Author:
jcastill
Message:

Changes as in branch branches/UKMO/r6232_INGV1_WAVE-coupling@7763

Location:
branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/CONFIG/SHARED/namelist_ref

    r7481 r7792  
    240240   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    241241   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    242    ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 ) 
    243    ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 ) 
     242   ln_cpl      = .false.   !  coupled   formulation                       ( requires key_oasis3 ) 
     243   ln_mixcpl   = .false.   !  forced-coupled mixed atmosphere formulation ( requires key_oasis3 ) 
     244   ln_wavcpl   = .false.   !  forced-coupled mixed wave       formulation ( requires key_oasis3 ) 
    244245   nn_components = 0       !  configuration of the opa-sas OASIS coupling 
    245246                           !  =0 no opa-sas OASIS coupling: default single executable configuration 
     
    276277                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 
    277278                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
     279   nn_drag   = 0           !  formula to calculate momentum from the wind components 
     280                           !  = 0 UKMO SHELF formulation 
     281                           !  = 1 standard formulation with forced of coupled drag coefficient 
     282                           !  = 2 standard formulation with constant drag coefficient 
    278283/ 
    279284!----------------------------------------------------------------------- 
     
    298303   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''       , '' 
    299304 
    300    cn_dir      = './'      !  root directory for the location of the flux files 
     305   cn_dir       = './'      !  root directory for the location of the flux files 
     306   ln_shelf_flx = .false.   !  UKMO SHELF specific flux flag - read from file wind components instead of momentum  
    301307/ 
    302308!----------------------------------------------------------------------- 
     
    12951301   sn_tauoc    =  'sdw_wave' ,        1          , 'wave_stress',     .true.   , .false. , 'daily'   ,  ''      , ''       , ''  
    12961302!  
    1297    cn_dir  = './'  !  root directory for the location of drag coefficient files 
     1303   cn_dir      = './'  !  root directory for the location of drag coefficient files 
    12981304/ 
    12991305!----------------------------------------------------------------------- 
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r7471 r7792  
    4242   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation 
    4343   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation 
     44   LOGICAL , PUBLIC ::   ln_wavcpl      !: ocean-wave forced-coupled mixed formulation 
     45   LOGICAL , PUBLIC ::   ll_purecpl     !: ocean-atmosphere or ocean-wave pure coupled formulation 
    4446   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    4547   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7481 r7792  
    956956      !!---------------------------------------------------------------------- 
    957957      USE zdf_oce,  ONLY : ln_zdfqiao 
     958      USE sbcflx ,  ONLY : ln_shelf_flx, nn_drag, jp_std 
    958959 
    959960      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     
    10391040      ELSE                                                   !   No dynamical coupling   ! 
    10401041         !                                                   ! ========================= ! 
     1042         ! it is possible that the momentum is calculated from the winds (ln_shelf_flx) and a coupled drag coefficient 
     1043         IF( srcv(jpr_wdrag)%laction .AND. ln_shelf_flx .AND. ln_cdgw .AND. nn_drag == jp_std ) THEN 
     1044            DO jj = 1, jpj 
     1045               DO ji = 1, jpi 
     1046                  ! here utau and vtau should contain the wind components as read from the forcing files 
     1047                  zcoef = SQRT(utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj)) 
     1048                  frcv(jpr_otx1)%z3(ji,jj,1) = zrhoa * frcv(jpr_wdrag)%z3(ji,jj,1) * utau(ji,jj) * zcoef 
     1049                  frcv(jpr_oty1)%z3(ji,jj,1) = zrhoa * frcv(jpr_wdrag)%z3(ji,jj,1) * vtau(ji,jj) * zcoef 
     1050                  utau(ji,jj) = frcv(jpr_otx1)%z3(ji,jj,1) 
     1051                  vtau(ji,jj) = frcv(jpr_oty1)%z3(ji,jj,1) 
     1052               END DO 
     1053            END DO 
     1054            llnewtx = .TRUE. 
     1055         ELSE 
    10411056         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
    10421057         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    10431058         llnewtx = .TRUE. 
     1059         ENDIF 
    10441060         ! 
    10451061      ENDIF 
     
    10611077            END DO 
    10621078            CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 
     1079            IF( .NOT. srcv(jpr_otx1)%laction .AND. srcv(jpr_wdrag)%laction .AND. & 
     1080                                ln_shelf_flx .AND. ln_cdgw .AND. nn_drag == jp_std ) & 
     1081               taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
    10631082            llnewtau = .TRUE. 
    10641083         ELSE 
     
    10751094      !                                                      ! ========================= ! 
    10761095      !                                                      !      10 m wind speed      !   (wndm) 
     1096      !                                                      !   include wave drag coef  !   (wndm) 
    10771097      !                                                      ! ========================= ! 
    10781098      ! 
     
    10851105!CDIR NOVERRCHK 
    10861106               DO ji = 1, jpi  
     1107                  IF( ln_shelf_flx ) THEN   ! the 10 wind module is properly calculated before if ln_shelf_flx 
     1108                     frcv(jpr_w10m)%z3(ji,jj,1) = wndm(ji,jj) 
     1109                  ELSE 
    10871110                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     1111                  ENDIF 
    10881112               END DO 
    10891113            END DO 
     
    10951119      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    10961120         ! 
     1121         ! if ln_wavcpl, the fields already contain the right information from forcing even if not ln_mixcpl 
    10971122         IF( ln_mixcpl ) THEN 
    1098             utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
    1099             vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
    1100             taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
    1101             wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
    1102          ELSE 
     1123            IF( srcv(jpr_otx1)%laction ) THEN 
     1124               utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     1125               vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     1126            ENDIF 
     1127            IF( srcv(jpr_taum)%laction )   & 
     1128               taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     1129            IF( srcv(jpr_w10m)%laction )   & 
     1130               wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     1131         ELSE IF( ll_purecpl ) THEN 
    11031132            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    11041133            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     
    11671196      IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1)  
    11681197       
    1169       !                                                      ! ========================= !   
    1170       !                                                      !   Wave drag coefficient   !  
    1171       !                                                      ! ========================= !   
    1172       IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 
    1173  
    11741198      !  Fields received by SAS when OASIS coupling 
    11751199      !  (arrays no more filled at sbcssm stage) 
     
    12421266               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    12431267            END SELECT 
    1244          ELSE 
     1268         ELSE IF( ll_purecpl ) THEN 
    12451269            zemp(:,:) = 0._wp 
    12461270         ENDIF 
     
    12501274         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    12511275          
    1252          IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
    1253          ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1276         IF( ln_mixcpl .AND. ( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction )) THEN 
     1277                                         emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1278         ELSE IF( ll_purecpl ) THEN  ;   emp(:,:) =                              zemp(:,:) 
    12541279         ENDIF 
    12551280         ! 
     
    12661291            ENDIF 
    12671292         ENDIF 
    1268          IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
    1269          ELSE                   ;   qns(:,:) =                              zqns(:,:) 
     1293         IF( ln_mixcpl .AND. ( srcv(jpr_qnsoce)%laction .OR. srcv(jpr_qnsmix)%laction )) THEN 
     1294                                          qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1295         ELSE IF( ll_purecpl ) THEN   ;   qns(:,:) =                              zqns(:,:) 
    12701296         ENDIF 
    12711297 
     
    12761302         ENDIF 
    12771303         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
    1278          IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
    1279          ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1304         IF( ln_mixcpl .AND. ( srcv(jpr_qsroce)%laction .OR. srcv(jpr_qsrmix)%laction )) THEN 
     1305                                          qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1306         ELSE IF( ll_purecpl ) THEN   ;   qsr(:,:) =                              zqsr(:,:) 
    12801307         ENDIF 
    12811308         ! 
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r7470 r7792  
    2222   USE lib_mpp         ! distribued memory computing library 
    2323   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     24   USE sbcwave         ! wave physics 
    2425 
    2526   IMPLICIT NONE 
     
    3233   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
    3334   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file 
     35 
     36   ! These lines are here just to allow merging with another branch 
     37   INTEGER, PUBLIC            ::   nn_drag        ! type of formula to calculate wind stress from wind components 
     38   INTEGER, PUBLIC, PARAMETER ::   jp_ukmo  = 0        ! UKMO SHELF formulation 
     39   INTEGER, PUBLIC, PARAMETER ::   jp_std   = 1        ! standard formulation with forced or coupled drag coefficient  
     40   INTEGER, PUBLIC, PARAMETER ::   jp_const = 2        ! standard formulation with constant drag coefficient  
     41 
    3442   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    3543   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    3644   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
     45   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 
     46   INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx)  
    3747 
    3848   !! * Substitutions 
     
    8191      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
    8292      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
     93      REAL(wp) ::   totwind               ! UKMO SHELF: Module of wind speed 
    8394      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    8495      !! 
    8596      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
     97      NAMELIST/namsbc_flx/ ln_shelf_flx                           ! Put here to allow merging with another UKMO branch 
    8698      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    8799      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read 
     
    140152            END DO 
    141153         END DO 
     154         !                                                        ! add modification due to drag coefficient read from wave forcing 
     155         !                                                        ! this code is inefficient but put here to allow merging with another UKMO branch 
     156         IF( ln_shelf_flx ) THEN 
     157            IF( ln_cdgw .AND. nn_drag == jp_std ) THEN 
     158               IF( cpl_wdrag ) THEN  
     159                  ! reset utau and vtau to the wind components: the momentum will 
     160                  ! be calculated from the coupled value of the drag coefficient 
     161                  DO jj = 1, jpj 
     162                     DO ji = 1, jpi 
     163                        utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     164                        vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     165                     END DO 
     166                  END DO 
     167               ELSE 
     168                  DO jj = 1, jpj 
     169                     DO ji = 1, jpi 
     170                        totwind = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 
     171                        utau(ji,jj) = zrhoa * cdn_wave(ji,jj) * sf(jp_utau)%fnow(ji,jj,1) * totwind 
     172                        vtau(ji,jj) = zrhoa * cdn_wave(ji,jj) * sf(jp_vtau)%fnow(ji,jj,1) * totwind 
     173                     END DO 
     174                  END DO 
     175               ENDIF 
     176            ELSE IF( nn_drag == jp_const ) THEN 
     177               DO jj = 1, jpj 
     178                  DO ji = 1, jpi 
     179                     totwind = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 
     180                     utau(ji,jj) = zrhoa * zcdrag * sf(jp_utau)%fnow(ji,jj,1) * totwind 
     181                     vtau(ji,jj) = zrhoa * zcdrag * sf(jp_vtau)%fnow(ji,jj,1) * totwind 
     182                  END DO 
     183               END DO 
     184            ENDIF 
     185         ENDIF 
    142186         !                                                        ! add to qns the heat due to e-p 
    143187         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     
    153197               zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    154198               taum(ji,jj) = zmod 
     199               IF( ln_shelf_flx ) THEN 
     200                  ztx = sf(jp_utau)%fnow(ji-1,jj  ) + sf(jp_utau)%fnow(ji,jj) 
     201                  zty = sf(jp_vtau)%fnow(ji  ,jj-1) + sf(jp_vtau)%fnow(ji,jj) 
     202                  wndm(ji,jj) = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     203               ELSE 
    155204               wndm(ji,jj) = SQRT( zmod * zcoef ) 
     205               ENDIF 
    156206            END DO 
    157207         END DO 
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7620 r7792  
    8989         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   & 
    9090         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   & 
    91          &             ln_tauoc  , ln_stcor  , nn_lsm, nn_limflx , nn_components, ln_cpl 
     91         &             ln_tauoc  , ln_stcor  , nn_lsm, nn_limflx , nn_components, ln_cpl  ,   & 
     92         &             ln_wavcpl , nn_drag 
    9293      INTEGER  ::   ios 
    9394      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
    94       LOGICAL  ::   ll_purecpl 
    9595      !!---------------------------------------------------------------------- 
    9696 
     
    131131         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    132132         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl 
    133          WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl 
     133         WRITE(numout,*) '              forced-coupled atm mixed formulation       ln_mixcpl   = ', ln_mixcpl 
     134         WRITE(numout,*) '              forced-coupled wav mixed formulation       ln_wavcpl   = ', ln_wavcpl 
    134135         WRITE(numout,*) '              wave physics                               ln_wave     = ', ln_wave  
    135136         WRITE(numout,*) '                 Stokes drift corr. to vert. velocity    ln_sdw      = ', ln_sdw  
    136137         WRITE(numout,*) '                 wave modified ocean stress              ln_tauoc    = ', ln_tauoc  
    137138         WRITE(numout,*) '                 Stokes coriolis term                    ln_stcor    = ', ln_stcor  
    138          WRITE(numout,*) '                 neutral drag coefficient (CORE, MFS)    ln_cdgw     = ', ln_cdgw 
     139         WRITE(numout,*) '                 neutral drag coefficient                ln_cdgw     = ', ln_cdgw 
    139140         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis 
    140141         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
     
    151152         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea 
    152153         WRITE(numout,*) '              n. of iterations if land-sea-mask applied  nn_lsm      = ', nn_lsm 
     154         WRITE(numout,*) '              momentum formulation (ln_shelf_flx)        nn_drag     = ', nn_drag 
    153155      ENDIF 
    154156 
     
    169171      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   & 
    170172         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
    171       IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
    172          &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     173      IF ( nn_components == jp_iam_opa .AND. ( ln_mixcpl .OR. ln_wavcpl) )   & 
     174         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl or ln_wavcpl = T in OPA' ) 
    173175      IF ( ln_cpl .AND. .NOT. lk_oasis )    & 
    174176         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
    175       IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
    176          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
    177       IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
    178          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
    179       IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
    180          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     177      IF( ( ln_mixcpl .OR. ln_wavcpl ) .AND. .NOT. lk_oasis )    & 
     178         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl or ln_wavcpl) requires the cpp key key_oasis3' ) 
     179      IF( ( ln_mixcpl .OR. ln_wavcpl ) .AND. .NOT. ln_cpl )    & 
     180         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl or ln_wavcpl) requires ln_cpl = T' ) 
     181      IF( ( ln_mixcpl .OR. ln_wavcpl ) .AND. nn_components /= jp_iam_nemo )    & 
     182         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl or ln_wavcpl) is not yet working with sas-opa coupling via oasis' ) 
    181183 
    182184      !                              ! allocate sbc arrays 
     
    224226         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) )   THEN   
    225227             CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=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') 
    229228         ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN   
    230229             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     
    239238      ENDIF  
    240239      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    241       ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     240      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl .AND. .NOT. ln_wavcpl 
    242241      ! 
    243242      icpt = 0 
     
    271270         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation' 
    272271         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis' 
    273          IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation' 
     272         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed atm formulation' 
     273         IF( ln_wavcpl          )   WRITE(numout,*) '              + forced-coupled mixed wav formulation' 
    274274         IF( nn_components/= jp_iam_nemo )  & 
    275275            &                       WRITE(numout,*) '              + OASIS coupled SAS' 
     
    395395      END SELECT 
    396396 
    397       IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     397      IF( ln_mixcpl .OR. ln_wavcpl )  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
    398398 
    399399      IF ( ln_wave .AND. ln_tauoc) THEN                 ! Wave stress subctracted  
  • branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r7606 r7792  
    6464   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd  , vsd  , wsd   !: Stokes drift velocities at u-, v- & w-points, resp. 
    6565 
    66    !! * Substitutions 
    6766#  include "vectopt_loop_substitute.h90" 
    6867   !!---------------------------------------------------------------------- 
     
    210209         CALL fld_read( kt, nn_fsbc, sf_cd )             ! read from external forcing 
    211210         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 
     211         ! check that the drag coefficient contains proper information even if 
     212         ! the masks do not match - the momentum stress is not masked! 
     213         WHERE( cdn_wave < 0.0 ) cdn_wave = 1.5e-3 
     214         WHERE( cdn_wave > 1.0 ) cdn_wave = 1.5e-3 
    212215      ENDIF 
    213216 
     
    215218         CALL fld_read( kt, nn_fsbc, sf_tauoc )          ! read wave norm stress from external forcing 
    216219         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) 
     220         WHERE( tauoc_wave < -100.0 ) tauoc_wave = 1.0 
     221         WHERE( tauoc_wave >  100.0 ) tauoc_wave = 1.0 
    217222      ENDIF 
    218223 
Note: See TracChangeset for help on using the changeset viewer.