source: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 5 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.6 KB
Line 
1MODULE dtauvd
2   !!======================================================================
3   !!                     ***  MODULE  dtauvd  ***
4   !! Ocean data  :  read ocean U & V current data from gridded data
5   !!======================================================================
6   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   dta_uvd_init  : read namelist and allocate data structures
11   !!   dta_uvd       : read and time-interpolate ocean U & V current data
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and tracers
14   USE phycst         ! physical constants
15   USE dom_oce        ! ocean space and time domain
16   !
17   USE in_out_manager ! I/O manager
18   USE fldread        ! read input fields
19   USE lib_mpp        ! MPP library
20   USE wrk_nemo       ! Memory allocation
21   USE timing         ! Timing
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   dta_uvd_init   ! called by nemogcm.F90
27   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90
28
29   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data
30   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data
31
32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data)
33
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
36   !! $Id$
37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE dta_uvd_init( ld_dyndmp )
42      !!----------------------------------------------------------------------
43      !!                   ***  ROUTINE dta_uvd_init  ***
44      !!                   
45      !! ** Purpose :   initialization of U & V current input data
46      !!
47      !! ** Method  : - read namc1d_uvd namelist
48      !!              - allocate U & V current data structure
49      !!              - fld_fill data structure with namelist information
50      !!----------------------------------------------------------------------
51      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used
52      !
53      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers
54      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used
55      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information
56      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information
57      !!
58      NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur
59      !!----------------------------------------------------------------------
60      !
61      IF( nn_timing == 1 )   CALL timing_start('dta_uvd_init')
62      !
63      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0
64
65      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist :
66      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901)
67901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp )
68      !
69      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run
70      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 )
71902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp )
72      IF(lwm) WRITE ( numond, namc1d_uvd )
73
74      !                             ! force the initialization when dyndmp is used
75      IF( PRESENT( ld_dyndmp ) )   ln_uvd_dyndmp = .TRUE.
76     
77      IF(lwp) THEN                  ! control print
78         WRITE(numout,*)
79         WRITE(numout,*) 'dta_uvd_init : U & V current data '
80         WRITE(numout,*) '~~~~~~~~~~~~ '
81         WRITE(numout,*) '   Namelist namc1d_uvd : Set flags'
82         WRITE(numout,*) '      Initialization of ocean U & V current with input data   ln_uvd_init   = ', ln_uvd_init
83         WRITE(numout,*) '      Damping of ocean U & V current toward input data        ln_uvd_dyndmp = ', ln_uvd_dyndmp
84         WRITE(numout,*)
85         IF( .NOT. ln_uvd_init .AND. .NOT. ln_uvd_dyndmp ) THEN
86            WRITE(numout,*)
87            WRITE(numout,*) '   U & V current data not used'
88         ENDIF
89      ENDIF
90      !                             ! no initialization when restarting
91      IF( ln_rstart .AND. ln_uvd_init ) THEN
92         CALL ctl_warn( 'dta_uvd_init: ocean restart and U & V current data initialization, ',   &
93            &           'we keep the restart U & V current values and set ln_uvd_init to FALSE' )
94         ln_uvd_init = .FALSE.
95      ENDIF
96
97      !
98      IF(  ln_uvd_init .OR. ln_uvd_dyndmp  ) THEN
99         !                          !==   allocate the data arrays   ==!
100         ALLOCATE( sf_uvd(2), STAT=ierr0 )
101         IF( ierr0 > 0 ) THEN
102            CALL ctl_stop( 'dta_uvd_init: unable to allocate sf_uvd structure' )             ;   RETURN
103         ENDIF
104         !
105                                 ALLOCATE( sf_uvd(1)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
106         IF( sn_ucur%ln_tint )   ALLOCATE( sf_uvd(1)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
107                                 ALLOCATE( sf_uvd(2)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
108         IF( sn_vcur%ln_tint )   ALLOCATE( sf_uvd(2)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
109         !
110         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
111            CALL ctl_stop( 'dta_uvd_init : unable to allocate U & V current data arrays' )   ;   RETURN
112         ENDIF
113         !                          !==   fill sf_uvd with sn_ucur, sn_vcur and control print   ==!
114         suv_i(1) = sn_ucur   ;   suv_i(2) = sn_vcur
115         CALL fld_fill( sf_uvd, suv_i, cn_dir, 'dta_uvd', 'U & V current data', 'namc1d_uvd' )
116         !
117      ENDIF
118      !
119      IF( nn_timing == 1 )  CALL timing_stop('dta_uvd_init')
120      !
121   END SUBROUTINE dta_uvd_init
122
123
124   SUBROUTINE dta_uvd( kt, puvd )
125      !!----------------------------------------------------------------------
126      !!                   ***  ROUTINE dta_uvd  ***
127      !!                   
128      !! ** Purpose :   provides U & V current data at time step kt
129      !!
130      !! ** Method  : - call fldread routine
131      !!              - ORCA_R2: make some hand made alterations to the data (EMPTY)
132      !!              - s- or mixed s-zps coordinate: vertical interpolation onto model mesh
133      !!              - zps coordinate: vertical interpolation onto last partial level
134      !!              - ln_uvd_dyndmp=False: deallocate the U & V current data structure,
135      !!                                     as the data is no longer used
136      !!
137      !! ** Action  :   puvd,  U & V current data interpolated onto model mesh at time-step kt
138      !!----------------------------------------------------------------------
139      INTEGER                           , INTENT(in   ) ::   kt     ! ocean time-step
140      REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT(  out) ::   puvd   ! U & V current data
141      !
142      INTEGER ::   ji, jj, jk, jl, jkk               ! dummy loop indicies
143      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1  ! local integers
144      REAL(wp)::   zl, zi                            ! local floats
145      REAL(wp), POINTER, DIMENSION(:) ::  zup, zvp   ! 1D workspace
146      !!----------------------------------------------------------------------
147      !
148      IF( nn_timing == 1 )   CALL timing_start('dta_uvd')
149      !
150      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==!
151      !
152      puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask
153      puvd(:,:,:,2) = sf_uvd(2)%fnow(:,:,:) 
154      !
155      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
156         !
157         CALL wrk_alloc( jpk,   zup, zvp )
158         !
159         IF( kt == nit000 .AND. lwp )THEN
160            WRITE(numout,*)
161            WRITE(numout,*) 'dta_uvd: interpolate U & V current data onto the s- or mixed s-z-coordinate mesh'
162         ENDIF
163         !
164         DO jj = 1, jpj                   ! vertical interpolation of U & V current:
165            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point
166               DO jk = 1, jpk
167                  zl = gdept_n(ji,jj,jk)
168                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
169                     zup(jk) =  puvd(ji,jj,1    ,1)
170                     zvp(jk) =  puvd(ji,jj,1    ,2)
171                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data
172                     zup(jk) =  puvd(ji,jj,jpkm1,1)
173                     zvp(jk) =  puvd(ji,jj,jpkm1,2)
174                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
175                     DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1)
176                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
177                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
178                           zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 
179                           zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi
180                        ENDIF
181                     END DO
182                  ENDIF
183               END DO
184               DO jk = 1, jpkm1           ! apply mask
185                  puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk)
186                  puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk)
187               END DO
188               puvd(ji,jj,jpk,1) = 0._wp
189               puvd(ji,jj,jpk,2) = 0._wp
190            END DO
191         END DO
192         !
193         CALL wrk_dealloc( jpk,   zup, zvp )
194         !
195      ELSE                                !==   z- or zps- coordinate   ==!
196         !                             
197         puvd(:,:,:,1) = puvd(:,:,:,1) * umask(:,:,:)       ! apply mask
198         puvd(:,:,:,2) = puvd(:,:,:,2) * vmask(:,:,:)
199         !
200         IF( ln_zps ) THEN                ! zps-coordinate (partial steps) interpolation at the last ocean level
201            DO jj = 1, jpj
202               DO ji = 1, jpi
203                  ik = mbkt(ji,jj) 
204                  IF( ik > 1 ) THEN
205                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
206                     puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1)
207                     puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2)
208                  ENDIF
209               END DO
210            END DO
211         ENDIF
212         !
213      ENDIF
214      !
215      IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==!
216         !                                !==   (data used only for initialization)  ==!
217         IF(lwp) WRITE(numout,*) 'dta_uvd: deallocate U & V current arrays as they are only used to initialize the run'
218                                   DEALLOCATE( sf_uvd(1)%fnow )     ! U current arrays in the structure
219         IF( sf_uvd(1)%ln_tint )   DEALLOCATE( sf_uvd(1)%fdta )
220                                   DEALLOCATE( sf_uvd(2)%fnow )     ! V current arrays in the structure
221         IF( sf_uvd(2)%ln_tint )   DEALLOCATE( sf_uvd(2)%fdta )
222                                   DEALLOCATE( sf_uvd         )     ! the structure itself
223      ENDIF
224      !
225      IF( nn_timing == 1 )  CALL timing_stop('dta_uvd')
226      !
227   END SUBROUTINE dta_uvd
228
229   !!======================================================================
230END MODULE dtauvd
Note: See TracBrowser for help on using the repository browser.