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.
dyndmp.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/C1D – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90 @ 7881

Last change on this file since 7881 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 11.0 KB
RevLine 
[4144]1MODULE dyndmp
2   !!======================================================================
3   !!                       ***  MODULE  dyndmp  ***
4   !! Ocean dynamics: internal restoring trend on momentum (U and V current)
[5102]5   !!                 This should only be used for C1D case in current form
[4144]6   !!======================================================================
7   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
[5102]8   !!            3.6  ! 2014-08  (T. Graham) Modified to use netcdf file of
9   !!                             restoration coefficients supplied to tradmp
[4144]10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   dyn_dmp_alloc : allocate dyndmp arrays
14   !!   dyn_dmp_init  : namelist read, parameter control and resto coeff.
15   !!   dyn_dmp       : update the momentum trend with the internal damping
16   !!----------------------------------------------------------------------
17   USE oce            ! ocean: variables
18   USE dom_oce        ! ocean: domain variables
19   USE c1d            ! 1D vertical configuration
20   USE tradmp         ! ocean: internal damping
21   USE zdf_oce        ! ocean: vertical physics
22   USE phycst         ! physical constants
23   USE dtauvd         ! data: U & V current
24   USE zdfmxl         ! vertical physics: mixed layer depth
[6140]25   !
[4144]26   USE in_out_manager ! I/O manager
27   USE lib_mpp        ! MPP library
28   USE prtctl         ! Print control
29   USE wrk_nemo       ! Memory allocation
30   USE timing         ! Timing
[5102]31   USE iom            ! I/O manager
[4144]32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   dyn_dmp_init ! routine called by nemogcm.F90
37   PUBLIC   dyn_dmp      ! routine called by step_c1d.F90
38
[6140]39   LOGICAL, PUBLIC ::   ln_dyndmp   !: Flag for Newtonian damping
[4144]40
[6140]41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    !: damping U current trend (m/s2)
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    !: damping V current trend (m/s2)
43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  !: restoring coeff. on U & V current
[4144]44
45   !! * Substitutions
46#  include "vectopt_loop_substitute.h90"
47   !!----------------------------------------------------------------------
[6140]48   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
[5215]49   !! $Id$
[4144]50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   INTEGER FUNCTION dyn_dmp_alloc()
55      !!----------------------------------------------------------------------
56      !!                ***  FUNCTION dyn_dmp_alloc  ***
57      !!----------------------------------------------------------------------
58      ALLOCATE( utrdmp(jpi,jpj,jpk), vtrdmp(jpi,jpj,jpk), resto_uv(jpi,jpj,jpk), STAT= dyn_dmp_alloc )
59      !
60      IF( lk_mpp            )   CALL mpp_sum ( dyn_dmp_alloc )
61      IF( dyn_dmp_alloc > 0 )   CALL ctl_warn('dyn_dmp_alloc: allocation of arrays failed')
62      !
63   END FUNCTION dyn_dmp_alloc
64
65
66   SUBROUTINE dyn_dmp_init
67      !!----------------------------------------------------------------------
68      !!                  ***  ROUTINE dyn_dmp_init  ***
69      !!
70      !! ** Purpose :   Initialization for the Newtonian damping
71      !!
72      !! ** Method  : - read the ln_dyndmp parameter from the namc1d_dyndmp namelist
73      !!              - allocate damping arrays
74      !!              - check the parameters of the namtra_dmp namelist
75      !!              - calculate damping coefficient
76      !!----------------------------------------------------------------------
[6140]77      INTEGER ::   ios, imask   ! local integers
78      !!
[4144]79      NAMELIST/namc1d_dyndmp/ ln_dyndmp
80      !!----------------------------------------------------------------------
[6140]81      !
[4245]82      REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist :
83      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901)
[6140]84901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp )
85      !
[4245]86      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run
87      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 )
[6140]88902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp )
[4624]89      IF(lwm) WRITE ( numond, namc1d_dyndmp )
[6140]90      !
[4144]91      IF(lwp) THEN                           ! control print
92         WRITE(numout,*)
93         WRITE(numout,*) 'dyn_dmp_init : U and V current Newtonian damping'
94         WRITE(numout,*) '~~~~~~~~~~~~'
95         WRITE(numout,*) '   Namelist namc1d_dyndmp : Set damping flag'
96         WRITE(numout,*) '      add a damping term or not       ln_dyndmp = ', ln_dyndmp
97         WRITE(numout,*) '   Namelist namtra_dmp    : Set damping parameters'
[5102]98         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
99         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
100         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
[4144]101         WRITE(numout,*)
102      ENDIF
[6140]103      !
[4144]104      IF( ln_dyndmp ) THEN
105         !                                   !==   allocate the data arrays   ==!
106         IF( dyn_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dyn_dmp_init: unable to allocate arrays' )
107         !
108         SELECT CASE ( nn_zdmp )             !==   control print of vertical option   ==!
109         CASE ( 0    )   ;   IF(lwp) WRITE(numout,*) '   momentum damping throughout the water column'
110         CASE ( 1    )   ;   IF(lwp) WRITE(numout,*) '   no momentum damping in the turbocline (avt > 5 cm2/s)'
111         CASE ( 2    )   ;   IF(lwp) WRITE(numout,*) '   no momentum damping in the mixed layer'
112         CASE DEFAULT
113            WRITE(ctmp1,*) '          bad flag value for nn_zdmp = ', nn_zdmp
114            CALL ctl_stop(ctmp1)
115         END SELECT
116         !
117         IF( .NOT. ln_uvd_dyndmp ) THEN      ! force the initialization of U & V current data for damping
118            CALL ctl_warn( 'dyn_dmp_init: U & V current read data not initialized, we force ln_uvd_dyndmp=T' )
119            CALL dta_uvd_init( ld_dyndmp=ln_dyndmp )
120         ENDIF
121         !
122         utrdmp(:,:,:) = 0._wp               ! internal damping trends
123         vtrdmp(:,:,:) = 0._wp
124         !
[5102]125         !Read in mask from file
126         CALL iom_open ( cn_resto, imask)
127         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
128         CALL iom_close( imask )
[4144]129      ENDIF
130      !
131   END SUBROUTINE dyn_dmp_init
132
133
134   SUBROUTINE dyn_dmp( kt )
135      !!----------------------------------------------------------------------
136      !!                   ***  ROUTINE dyn_dmp  ***
137      !!                 
138      !! ** Purpose :   Compute the momentum trends due to a newtonian damping
139      !!      of the ocean velocities towards the given data and add it to the
140      !!      general momentum trends.
141      !!
142      !! ** Method  :   Compute Newtonian damping towards u_dta and v_dta
143      !!      and add to the general momentum trends:
144      !!                     ua = ua + resto_uv * (u_dta - ub)
145      !!                     va = va + resto_uv * (v_dta - vb)
146      !!      The trend is computed either throughout the water column
147      !!      (nn_zdmp=0), where the vertical mixing is weak (nn_zdmp=1) or
148      !!      below the well mixed layer (nn_zdmp=2)
149      !!
150      !! ** Action  : - (ua,va)   momentum trends updated with the damping trend
151      !!----------------------------------------------------------------------
[6140]152      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[4144]153      !!
[6140]154      INTEGER  ::   ji, jj, jk   ! dummy loop indices
155      REAL(wp) ::   zua, zva     ! local scalars
156      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuv_dta   ! Read in data
[4144]157      !!----------------------------------------------------------------------
158      !
159      IF( nn_timing == 1 )  CALL timing_start( 'dyn_dmp' )
160      !
[6140]161      CALL wrk_alloc( jpi,jpj,jpk,2,   zuv_dta )
[4144]162      !
163      !                           !==   read and interpolate U & V current data at kt   ==!
164      CALL dta_uvd( kt, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside
165                                  !!!       the C1D context (use of U,V grid variables)
166      !
167      SELECT CASE ( nn_zdmp )     !==   Calculate/add Newtonian damping to the momentum trend   ==!
168      !
169      CASE( 0 )                   ! Newtonian damping throughout the water column
170         DO jk = 1, jpkm1
171            DO jj = 2, jpjm1
172               DO ji = fs_2, fs_jpim1   ! vector opt.
173                  zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
174                  zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
175                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
176                  va(ji,jj,jk) = va(ji,jj,jk) + zva
177                  utrdmp(ji,jj,jk) = zua           ! save the trends
178                  vtrdmp(ji,jj,jk) = zva     
179               END DO
180            END DO
181         END DO
182         !
183      CASE ( 1 )                  ! no damping above the turbocline (avt > 5 cm2/s)
184         DO jk = 1, jpkm1
185            DO jj = 2, jpjm1
186               DO ji = fs_2, fs_jpim1   ! vector opt.
187                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
188                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
189                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
190                  ELSE
191                     zua = 0._wp
192                     zva = 0._wp 
193                  ENDIF
194                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
195                  va(ji,jj,jk) = va(ji,jj,jk) + zva
196                  utrdmp(ji,jj,jk) = zua           ! save the trends
197                  vtrdmp(ji,jj,jk) = zva
198               END DO
199            END DO
200         END DO
201         !
202      CASE ( 2 )                  ! no damping in the mixed layer
203         DO jk = 1, jpkm1
204            DO jj = 2, jpjm1
205               DO ji = fs_2, fs_jpim1   ! vector opt.
[6140]206                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
[4144]207                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
208                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
209                  ELSE
210                     zua = 0._wp
211                     zva = 0._wp 
212                  ENDIF
213                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
214                  va(ji,jj,jk) = va(ji,jj,jk) + zva
215                  utrdmp(ji,jj,jk) = zua           ! save the trends
216                  vtrdmp(ji,jj,jk) = zva
217               END DO
218            END DO
219         END DO
220         !
221      END SELECT
222      !
223      !                           ! Control print
224      IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   &
225         &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
226      !
[6140]227      CALL wrk_dealloc( jpi,jpj,jpk,2,   zuv_dta )
[4144]228      !
229      IF( nn_timing == 1 )  CALL timing_stop( 'dyn_dmp')
230      !
231   END SUBROUTINE dyn_dmp
232
233   !!======================================================================
234END MODULE dyndmp
Note: See TracBrowser for help on using the repository browser.