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.
sbcwave.F90 in branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 @ 5777

Last change on this file since 5777 was 5777, checked in by gm, 8 years ago

#1593: LDF-ADV, III. Phasing of the improvements/simplifications of ADV & LDF momentum trends (see wiki page)

  • Property svn:keywords set to Id
File size: 9.4 KB
Line 
1MODULE sbcwave
2   !!======================================================================
3   !!                       ***  MODULE  sbcwave  ***
4   !! Wave module
5   !!======================================================================
6   !! History :  3.3  !   2011-09  (Adani M)  Original code: Drag Coefficient
7   !!         :  3.4  !   2012-10  (Adani M)                 Stokes Drift
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   sbc_wave      : read drag coefficient from wave model in netcdf files
12   !!----------------------------------------------------------------------
13   USE oce            !
14   USE sbc_oce        ! Surface boundary condition: ocean fields
15   USE bdy_oce        !
16   USE domvvl         !
17   !
18   USE iom            ! I/O manager library
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! distribued memory computing library
21   USE fldread        ! read input fields
22   USE wrk_nemo       !
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
28   
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 
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   SUBROUTINE sbc_wave( kt )
52      !!---------------------------------------------------------------------
53      !!                     ***  ROUTINE sbc_apr  ***
54      !!
55      !! ** Purpose :   read drag coefficient from wave model  in netcdf files.
56      !!
57      !! ** Method  : - Read namelist namsbc_wave
58      !!              - Read Cd_n10 fields in netcdf files
59      !!              - Read stokes drift 2d in netcdf files
60      !!              - Read wave number      in netcdf files
61      !!              - Compute 3d stokes drift using monochromatic
62      !! ** action  :   
63      !!---------------------------------------------------------------------
64      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
65      !
66      INTEGER                ::   ierror   ! return error code
67      INTEGER                ::   ifpr, jj,ji,jk 
68      INTEGER                ::   ios     ! Local integer output status for namelist read
69      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
70      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
72      REAL(wp), DIMENSION(:,:,:), POINTER ::   zusd_t, zvsd_t, ze3hdiv   ! 3D workspace
73      !!
74      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn
75      !!---------------------------------------------------------------------
76      !
77      !                                         ! -------------------- !
78      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
79         !                                      ! -------------------- !
80         REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
81         READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
82901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp )
83
84         REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
85         READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
86902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp )
87         IF(lwm) WRITE ( numond, namsbc_wave )
88         !
89         IF ( ln_cdgw ) THEN
90            ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
91            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
92            !
93                                   ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   )
94            IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
95            CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
96            ALLOCATE( cdn_wave(jpi,jpj) )
97            cdn_wave(:,:) = 0.0
98         ENDIF
99         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
102            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
103            !
104            DO ifpr= 1, jpfld
105               ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
106               IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
107            END DO
108            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) )
110            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
114         ENDIF
115      ENDIF
116      !
117      IF ( ln_cdgw ) THEN              !==  Neutral drag coefficient  ==!
118         CALL fld_read( kt, nn_fsbc, sf_cd )      ! read from external forcing
119         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
120      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+1,jj,jk) ) * vmask(ji,jj,jk)
139               END DO
140            END DO
141         END DO
142         CALL lbc_lnk( usd3d(:,:,:), 'U', -1. )
143         CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. )
144         !
145         DO jk = 1, jpkm1                       !* e3t * Horizontal divergence  ==!
146            DO jj = 2, jpjm1
147               DO ji = fs_2, fs_jpim1   ! vector opt.
148                  ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     &
149                     &                 - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     &
150                     &                 + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     &
151                     &                 - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj)
152               END DO 
153            END DO 
154            IF( .NOT. AGRIF_Root() ) THEN
155               IF( nbondi ==  1 .OR. nbondi == 2 )   ze3hdiv(nlci-1,   :  ,jk) = 0._wp      ! east
156               IF( nbondi == -1 .OR. nbondi == 2 )   ze3hdiv(  2   ,   :  ,jk) = 0._wp      ! west
157               IF( nbondj ==  1 .OR. nbondj == 2 )   ze3hdiv(  :   ,nlcj-1,jk) = 0._wp      ! north
158               IF( nbondj == -1 .OR. nbondj == 2 )   ze3hdiv(  :   ,  2   ,jk) = 0._wp      ! south
159            ENDIF
160         END DO
161         CALL lbc_lnk( ze3hdiv, 'T', 1. ) 
162         !
163         DO jk = jpkm1, 1, -1                   !* integrate from the bottom the e3t * hor. divergence
164            wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk)
165         END DO
166#if defined key_bdy
167         IF( lk_bdy ) THEN
168            DO jk = 1, jpkm1
169               wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
170            END DO
171         ENDIF
172#endif
173         CALL wrk_dealloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv )
174         !
175      ENDIF
176      !
177   END SUBROUTINE sbc_wave
178     
179   !!======================================================================
180END MODULE sbcwave
Note: See TracBrowser for help on using the repository browser.