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_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • 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,jj+1,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.