Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

dtauvd.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago
All wrk_alloc removed
Property svn:keywords set to `Id`
File size: 11.4 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90 @ 7910

Download in other formats: