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/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 @ 5728

Last change on this file since 5728 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

File size: 10.0 KB
Line 
1MODULE sbcwave
2   !!======================================================================
3   !!                       ***  MODULE  sbcwave  ***
4   !! Wave module
5   !!======================================================================
6   !! History :  3.3.1  !   2011-09  (Adani M)  Original code: Drag Coefficient
7   !!         :  3.4    !   2012-10  (Adani M)                 Stokes Drift
8   !!----------------------------------------------------------------------
9   USE iom             ! I/O manager library
10   USE in_out_manager  ! I/O manager
11   USE lib_mpp         ! distribued memory computing library
12   USE fldread        ! read input fields
13   USE oce
14   USE sbc_oce        ! Surface boundary condition: ocean fields
15   USE domvvl
16
17   
18   !!----------------------------------------------------------------------
19   !!   sbc_wave       : read drag coefficient from wave model in netcdf files
20   !!----------------------------------------------------------------------
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
26   
27   INTEGER , PARAMETER ::   jpfld  = 3           ! maximum number of files to read for srokes drift
28   INTEGER , PARAMETER ::   jp_usd = 1           ! index of stokes drift  (i-component) (m/s)    at T-point
29   INTEGER , PARAMETER ::   jp_vsd = 2           ! index of stokes drift  (j-component) (m/s)    at T-point
30   INTEGER , PARAMETER ::   jp_wn  = 3           ! index of wave number                 (1/m)    at T-point
31   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd    ! structure of input fields (file informations, fields read) Drag Coefficient
32   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd    ! structure of input fields (file informations, fields read) Stokes Drift
33   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave 
34   REAL(wp),ALLOCATABLE,DIMENSION (:,:)              :: usd2d,vsd2d,uwavenum,vwavenum 
35   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: usd3d,vsd3d,wsd3d 
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
41   !! $Id: $
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE sbc_wave( kt )
47      !!---------------------------------------------------------------------
48      !!                     ***  ROUTINE sbc_apr  ***
49      !!
50      !! ** Purpose :   read drag coefficient from wave model  in netcdf files.
51      !!
52      !! ** Method  : - Read namelist namsbc_wave
53      !!              - Read Cd_n10 fields in netcdf files
54      !!              - Read stokes drift 2d in netcdf files
55      !!              - Read wave number      in netcdf files
56      !!              - Compute 3d stokes drift using monochromatic
57      !! ** action  :   
58      !!               
59      !!---------------------------------------------------------------------
60      USE oce,  ONLY : un,vn,hdivn,rotn
61      USE divcur
62      USE wrk_nemo
63#if defined key_bdy
64      USE bdy_oce, ONLY : bdytmask
65#endif
66      INTEGER, INTENT( in  ) ::  kt       ! ocean time step
67      INTEGER                ::  ierror   ! return error code
68      INTEGER                ::  ifpr, jj,ji,jk 
69      INTEGER                ::   ios     ! Local integer output status for namelist read
70      REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy,rotdummy
71      REAL                                          ::  z2dt,z1_2dt
72      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
73      CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files
74      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd, sn_wn   ! informations about the fields to be read
75      !!---------------------------------------------------------------------
76      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn
77      !!---------------------------------------------------------------------
78
79      !!----------------------------------------------------------------------
80      !
81      !
82      !                                         ! -------------------- !
83      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
84         !                                      ! -------------------- !
85         REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
86         READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
87901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp )
88
89         REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
90         READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
91902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp )
92         IF(lwm) WRITE ( numond, namsbc_wave )
93         !
94
95         IF ( ln_cdgw ) THEN
96            ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
97            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
98            !
99                                   ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   )
100            IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
101            CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
102            ALLOCATE( cdn_wave(jpi,jpj) )
103            cdn_wave(:,:) = 0.0
104        ENDIF
105         IF ( ln_sdw ) THEN
106            slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn
107            ALLOCATE( sf_sd(3), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
108            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
109            !
110            DO ifpr= 1, jpfld
111               ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
112               IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
113            END DO
114            CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
115            ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) )
116            ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) )
117            usd2d(:,:) = 0.0 ;  vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0
118            usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0
119         ENDIF
120      ENDIF
121         !
122         !
123      IF ( ln_cdgw ) THEN
124         CALL fld_read( kt, nn_fsbc, sf_cd )      !* read drag coefficient from external forcing
125         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
126      ENDIF
127      IF ( ln_sdw )  THEN
128          CALL fld_read( kt, nn_fsbc, sf_sd )      !* read drag coefficient from external forcing
129
130         ! Interpolate wavenumber, stokes drift into the grid_V and grid_V
131         !-------------------------------------------------
132
133         DO jj = 1, jpjm1
134            DO ji = 1, jpim1
135               uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
136               &                                + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
137
138               vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
139               &                                + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
140
141               usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) &
142               &                                + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
143
144               vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) &
145               &                                + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
146            END DO
147         END DO
148
149          !Computation of the 3d Stokes Drift
150          DO jk = 1, jpk
151             DO jj = 1, jpj-1
152                DO ji = 1, jpi-1
153                   usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk))))
154                   vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk))))
155                END DO
156             END DO
157             usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept_0(jpi,:,jk)) )
158             vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept_0(:,jpj,jk)) )
159          END DO
160
161          CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
162         
163          udummy(:,:,:)=un(:,:,:)
164          vdummy(:,:,:)=vn(:,:,:)
165          hdivdummy(:,:,:)=hdivn(:,:,:)
166          rotdummy(:,:,:)=rotn(:,:,:)
167          un(:,:,:)=usd3d(:,:,:)
168          vn(:,:,:)=vsd3d(:,:,:)
169          CALL div_cur(kt)
170      !                                           !------------------------------!
171      !                                           !     Now Vertical Velocity    !
172      !                                           !------------------------------!
173          z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
174
175          z1_2dt = 1.e0 / z2dt
176          DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
177             ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
178             wsd3d(:,:,jk) = wsd3d(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
179                &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
180                &                         * tmask(:,:,jk) * z1_2dt
181#if defined key_bdy
182             wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
183#endif
184          END DO
185          hdivn(:,:,:)=hdivdummy(:,:,:)
186          rotn(:,:,:)=rotdummy(:,:,:)
187          vn(:,:,:)=vdummy(:,:,:)
188          un(:,:,:)=udummy(:,:,:)
189          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
190      ENDIF
191   END SUBROUTINE sbc_wave
192     
193   !!======================================================================
194END MODULE sbcwave
Note: See TracBrowser for help on using the repository browser.