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 5983 for branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 – NEMO

Ignore:
Timestamp:
2015-12-02T17:12:45+01:00 (8 years ago)
Author:
emanuelaclementi
Message:

ticket #1643 Aligned branch INGV1-WAVE at trunk revision 5936

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r5860 r5983  
    66   !! History :  3.3  !   2011-09  (Adani M)  Original code: Drag Coefficient  
    77   !!         :  3.4  !   2012-10  (Adani M)                 Stokes Drift  
     8   !! History :  3.6  !2014-09  (Clementi E, Oddo P)New Stokes Drift Computation 
    89   !!---------------------------------------------------------------------- 
    910 
     
    1213   !!---------------------------------------------------------------------- 
    1314   USE oce            !  
    14    USE sbc_oce        ! Surface boundary condition: ocean fields 
     15   USE sbc_oce       ! Surface boundary condition: ocean fields 
    1516   USE bdy_oce        ! 
    1617   USE domvvl         ! 
     
    1920   USE in_out_manager ! I/O manager 
    2021   USE lib_mpp        ! distribued memory computing library 
    21    USE fldread        ! read input fields 
     22   USE fldread       ! read input fields 
    2223   USE wrk_nemo       ! 
     24   USE phycst         ! physical constants  
    2325 
    2426   IMPLICIT NONE 
     
    2729   PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs 
    2830    
    29    INTEGER , PARAMETER ::   jpfld  = 3   ! maximum number of files to read for srokes drift 
    30    INTEGER , PARAMETER ::   jp_usd = 1   ! index of stokes drift  (i-component) (m/s)    at T-point 
    31    INTEGER , PARAMETER ::   jp_vsd = 2   ! index of stokes drift  (j-component) (m/s)    at T-point 
    32    INTEGER , PARAMETER ::   jp_wn  = 3   ! index of wave number                 (1/m)    at T-point 
    33  
    34    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd    ! structure of input fields (file informations, fields read) Drag Coefficient 
    35    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd    ! structure of input fields (file informations, fields read) Stokes Drift 
    36  
    37    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:)   :: cdn_wave  
    38    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: usd3d, vsd3d, wsd3d  
    39    REAL(wp),         ALLOCATABLE, DIMENSION (:,:)   :: usd2d, vsd2d, uwavenum, vwavenum  
     31   INTEGER , PARAMETER ::   jpfld  = 4           ! number of files to read for stokes drift 
     32   INTEGER , PARAMETER ::   jp_usd = 1           ! index of stokes drift  (i-component) (m/s)    at T-point 
     33   INTEGER , PARAMETER ::   jp_vsd = 2           ! index of stokes drift  (j-component) (m/s)    at T-point 
     34   INTEGER , PARAMETER ::   jp_swh = 3           ! index of significant wave hight      (m)      at T-point 
     35   INTEGER , PARAMETER ::   jp_wmp = 4           ! index of mean wave period            (s)      at T-point 
     36! 
     37   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd    ! structure of input fields (file informations, fields read) Drag Coefficient 
     38   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd    ! structure of input fields (file informations, fields read) Stokes Drift 
     39   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_wn    ! structure of input fields (file informations, fields read) wave number for Qiao 
     40   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 
     41   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave  
     42   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: usd2d,vsd2d 
     43   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: swh,wmp,wnum 
     44   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: usd2dt,vsd2dt,tsd2d 
     45   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: usd3d,vsd3d,wsd3d  
     46   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: tauoc_wave 
    4047 
    4148   !! * Substitutions 
     
    5865      !!              - Read Cd_n10 fields in netcdf files  
    5966      !!              - Read stokes drift 2d in netcdf files  
    60       !!              - Read wave number      in netcdf files  
    61       !!              - Compute 3d stokes drift using monochromatic 
     67      !!              - Read wave number in netcdf files  
     68      !!              - Compute 3d stokes drift using Breivik et al.,2014 
     69      !!                formulation 
    6270      !! ** action  :    
    6371      !!--------------------------------------------------------------------- 
     72      USE zdf_oce,  ONLY : ln_zdfqiao 
     73 
    6474      INTEGER, INTENT( in  ) ::   kt       ! ocean time step 
    6575      ! 
    6676      INTEGER                ::   ierror   ! return error code 
    6777      INTEGER                ::   ifpr, jj,ji,jk  
    68       INTEGER                ::   ios     ! Local integer output status for namelist read 
     78      INTEGER                ::   ios      ! Local integer output status for namelist read 
     79 
     80      REAL(wp)                       ::  ztransp,zsp0, zk, zus,zvs 
     81      REAL(wp), DIMENSION(jpi,jpj)   ::  zfac  
     82 
    6983      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    7084      CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files 
    71       TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd, sn_wn   ! informations about the fields to be read 
     85      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd,  & 
     86                             &   sn_swh, sn_wmp, sn_wnum, sn_tauoc      ! informations about the fields to be read 
    7287      REAL(wp), DIMENSION(:,:,:), POINTER ::   zusd_t, zvsd_t, ze3hdiv   ! 3D workspace 
    7388      !! 
    74       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn 
     89      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_swh, sn_wmp, sn_wnum, sn_tauoc 
    7590      !!--------------------------------------------------------------------- 
    7691      ! 
     
    97112            cdn_wave(:,:) = 0.0 
    98113         ENDIF 
     114! 
     115         IF ( ln_tauoc ) THEN 
     116            ALLOCATE( sf_tauoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauoc 
     117            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 
     118            ! 
     119                                   ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1)   ) 
     120            IF( sn_cdg%ln_tint )   ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) ) 
     121            CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
     122            ALLOCATE( tauoc_wave(jpi,jpj) ) 
     123            tauoc_wave(:,:) = 0.0 
     124        ENDIF 
     125! 
    99126         IF ( ln_sdw ) THEN 
    100             slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn 
    101             ALLOCATE( sf_sd(3), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg 
     127            slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; 
     128            slf_i(jp_swh) = sn_swh ; slf_i(jp_wmp) = sn_wmp; 
     129            ALLOCATE( sf_sd(jpfld), STAT=ierror )           !* allocate and fill sf_sd with stokes drift 
    102130            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 
    103131            ! 
     
    106134               IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 
    107135            END DO 
     136! 
    108137            CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 
    109             ALLOCATE( usd2d(jpi,jpj) , vsd2d(jpi,jpj) , uwavenum(jpi,jpj) , vwavenum(jpi,jpj) ) 
     138            ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),usd2dt(jpi,jpj),vsd2dt(jpi,jpj)) 
    110139            ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) ) 
    111             usd3d(:,:,:) = 0._wp   ;   usd2d(:,:) = 0._wp   ;    uwavenum(:,:) = 0._wp 
    112             vsd3d(:,:,:) = 0._wp   ;   vsd2d(:,:) = 0._wp   ;    vwavenum(:,:) = 0._wp 
    113             wsd3d(:,:,:) = 0._wp 
     140            ALLOCATE( swh(jpi,jpj), wmp(jpi,jpj) ) 
     141            usd3d(:,:,:) = 0._wp   ;   usd2d(:,:) = 0._wp   ;    usd2dt(:,:) = 0._wp ; 
     142            vsd3d(:,:,:) = 0._wp   ;   vsd2d(:,:) = 0._wp   ;    vsd2dt(:,:) = 0._wp ; 
     143            wsd3d(:,:,:) = 0._wp   ; 
     144            swh  (:,:)   = 0._wp   ;    wmp (:,:) = 0._wp ; 
     145            IF ( ln_zdfqiao ) THEN     !==  Vertical mixing enhancement using Qiao,2010  ==! 
     146               ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
     147               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable toallocate sf_wave structure' ) 
     148                                      ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   ) 
     149               IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 
     150               CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
     151               ALLOCATE( wnum(jpi,jpj),tsd2d(jpi,jpj) ) 
     152               wnum(:,:) = 0._wp ; tsd2d(:,:) = 0._wp 
     153            ENDIF 
    114154         ENDIF 
    115155      ENDIF 
     
    119159         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 
    120160      ENDIF 
    121       ! 
    122       IF ( ln_sdw )  THEN              !==  Computation of the 3d Stokes Drift  ==! 
    123          ! 
    124          CALL fld_read( kt, nn_fsbc, sf_sd )    !* read drag coefficient from external forcing 
    125          ! 
    126          ! 
    127          CALL wrk_alloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv ) 
    128          !                                      !* distribute it on the vertical 
    129          DO jk = 1, jpkm1 
    130             zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
    131             zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
    132          END DO 
    133          !                                      !* interpolate the stokes drift from t-point to u- and v-points 
    134          DO jk = 1, jpkm1 
    135             DO jj = 1, jpjm1 
    136                DO ji = 1, jpim1 
    137                    usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji  ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk) 
    138                    vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji  ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk) 
    139                END DO 
    140             END DO 
    141          END DO 
     161! 
     162      IF ( ln_tauoc ) THEN             !==  Wave induced stress  ==! 
     163         CALL fld_read( kt, nn_fsbc, sf_tauoc )      !* read wave norm stress from external forcing 
     164         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) 
     165      ENDIF 
     166! 
     167      IF ( ln_sdw )  THEN                         !==  Computation of the 3d Stokes Drift  ==!  
     168         ! 
     169         CALL fld_read( kt, nn_fsbc, sf_sd )      !* read wave parameters from external forcing 
     170         swh(:,:)    = sf_sd(jp_swh)%fnow(:,:,1)  ! significant wave height 
     171         wmp(:,:)    = sf_sd(jp_wmp)%fnow(:,:,1)  ! wave mean period 
     172         usd2dt(:,:) = sf_sd(jp_usd)%fnow(:,:,1)  ! 2D zonal Stokes Drift 
     173         vsd2dt(:,:) = sf_sd(jp_vsd)%fnow(:,:,1)  ! 2D meridional Stokes Drift 
     174         ! 
     175         !==  Computation of the 3d Stokes Drift according to Breivik et al.,2014 
     176         !(DOI: 10.1175/JPO-D-14-0020.1)==!  
     177         ! 
     178         CALL wrk_alloc( jpi,jpj,jpk, ze3hdiv ) 
     179          DO jk = 1, jpk 
     180             DO jj = 1, jpj 
     181                DO ji = 1, jpi 
     182               ! On T grid 
     183               ! Stokes transport speed estimated from Hs and Tmean 
     184               ztransp = 2.0_wp*rpi*swh(ji,jj)**2.0_wp/(16.0_wp*MAX(wmp(ji,jj),0.0000001_wp)) 
     185               ! Stokes surface speed 
     186               zsp0 = SQRT( sf_sd(jp_usd)%fnow(ji,jj,1)**2 +  sf_sd(jp_vsd)%fnow(ji,jj,1)**2) 
     187               ! Wavenumber scale 
     188               zk = ABS(zsp0)/MAX(ABS(5.97_wp*ztransp),0.0000001_wp) 
     189               ! Depth attenuation 
     190               zfac(ji,jj) = EXP(-2.0_wp*zk*fsdept(ji,jj,jk))/(1.0_wp+8.0_wp*zk*fsdept(ji,jj,jk)) 
     191                END DO 
     192             END DO 
     193! 
     194             DO jj = 1, jpjm1 
     195                DO ji = 1, jpim1 
     196                 ! Into the U and V Grid  
     197                 zus = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) & 
     198                 &                                + zfac(ji+1,jj) * tmask(ji+1,jj,1) ) 
     199! 
     200                 zvs = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) & 
     201                 &                                + zfac(ji,jj+1) * tmask(ji,jj+1,1) ) 
     202! 
     203                 usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( usd2dt(ji,jj) * tmask(ji,jj,1) & 
     204                 &                                             +  usd2dt(ji+1,jj) * tmask(ji+1,jj,1) ) 
     205! 
     206                 vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( vsd2dt(ji,jj) * tmask(ji,jj,1) & 
     207                 &                                              + vsd2dt(ji,jj+1) * tmask(ji,jj+1,1) ) 
     208! 
     209                 usd3d(ji,jj,jk) = usd2d(ji,jj)*zus 
     210                 vsd3d(ji,jj,jk) = vsd2d(ji,jj)*zvs 
     211                END DO 
     212             END DO 
     213          END DO 
     214         ! 
    142215         CALL lbc_lnk( usd3d(:,:,:), 'U', -1. ) 
    143216         CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 
     
    171244         ENDIF 
    172245#endif 
    173          CALL wrk_dealloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv ) 
    174          !  
     246!         CALL wrk_dealloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv ) 
     247         CALL wrk_dealloc( jpi,jpj,jpk, ze3hdiv ) 
     248! 
     249        IF ( ln_zdfqiao )  THEN 
     250          wnum(:,:) = sf_wn(1)%fnow(:,:,1) 
     251         ! Calculate the module of the stokes drift on T grid 
     252         !------------------------------------------------- 
     253         DO jj = 1, jpj 
     254            DO ji = 1, jpi 
     255                tsd2d(ji,jj) = ((sf_sd(jp_usd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0  +     & 
     256                &               (sf_sd(jp_vsd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0)**0.5 
     257            END DO 
     258         END DO 
     259        ENDIF 
     260      ! 
    175261      ENDIF 
    176262      ! 
Note: See TracChangeset for help on using the changeset viewer.