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.

trcdta.F90 in branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/2013/dev_CMCC_INGV_2013/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 4217

Last change on this file since 4217 was 4217, checked in by poddo, 11 years ago
Solved problems with namelist parameter land/sea mask
Property svn:keywords set to `Id`
File size: 13.8 KB

Line
1	MODULE trcdta
2	!!======================================================================
3	!! * MODULE trcdta *
4	!! TOP : reads passive tracer data
5	!!=====================================================================
6	!! History : 1.0 ! 2002-04 (O. Aumont) original code
7	!! - ! 2004-03 (C. Ethe) module
8	!! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90
9	!! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation
10	!! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models
11	!!----------------------------------------------------------------------
12	#if defined key_top
13	!!----------------------------------------------------------------------
14	!! 'key_top' TOP model
15	!!----------------------------------------------------------------------
16	!! trc_dta : read and time interpolated passive tracer data
17	!!----------------------------------------------------------------------
18	USE par_trc ! passive tracers parameters
19	USE oce_trc ! shared variables between ocean and passive tracers
20	USE trc ! passive tracers common variables
21	USE iom ! I/O manager
22	USE lib_mpp ! MPP library
23	USE fldread ! read input fields
24
25	IMPLICIT NONE
26	PRIVATE
27
28	PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90
29	PUBLIC trc_dta_init ! called in trcini.F90
30
31	INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data
32	INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data
33	INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
34	REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values
35	TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read)
36
37	!! * Substitutions
38	# include "domzgr_substitute.h90"
39	!!----------------------------------------------------------------------
40	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
41	!! $Id$
42	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
43	!!----------------------------------------------------------------------
44	CONTAINS
45
46	SUBROUTINE trc_dta_init(ntrc)
47	!!----------------------------------------------------------------------
48	!! * ROUTINE trc_dta_init *
49	!!
50	!! ** Purpose : initialisation of passive tracer input data
51	!!
52	!! ** Method : - Read namtsd namelist
53	!! - allocates passive tracer data structure
54	!!----------------------------------------------------------------------
55	!
56	INTEGER,INTENT(IN) :: ntrc ! number of tracers
57	INTEGER :: jl, jn ! dummy loop indices
58	INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers
59	INTEGER :: ios ! Local integer output status for namelist read
60	CHARACTER(len=100) :: clndta, clntrc
61	REAL(wp) :: zfact
62	!
63	CHARACTER(len=100) :: cn_dir
64	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
65	TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
66	REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trfac ! multiplicative factor for tracer values
67	!!
68	NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac
69	!!----------------------------------------------------------------------
70	!
71	IF( nn_timing == 1 ) CALL timing_start('trc_dta_init')
72	!
73	! Initialisation
74	ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0
75	! Compute the number of tracers to be initialised with data
76	ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
77	IF( ierr0 > 0 ) THEN
78	CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN
79	ENDIF
80	nb_trcdta = 0
81	n_trc_index(:) = 0
82	DO jn = 1, ntrc
83	IF( ln_trc_ini(jn) ) THEN
84	nb_trcdta = nb_trcdta + 1
85	n_trc_index(jn) = nb_trcdta
86	ENDIF
87	ENDDO
88	!
89	ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking
90	IF(lwp) THEN
91	WRITE(numout,*) ' '
92	WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
93	WRITE(numout,*) ' '
94	ENDIF
95	! ! allocate the arrays (if necessary)
96	!
97	cn_dir = './' ! directory in which the model is executed
98	DO jn = 1, ntrc
99	WRITE( clndta,'("TR_",I1)' ) jn
100	clndta = TRIM( clndta )
101	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! land/sea mask !
102	! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! filename !
103	sn_trcdta(jn) = FLD_N( clndta , -1 , clndta , .false. , .true. , 'monthly' , '' , &
104	& '' , '' )
105	!
106	rn_trfac(jn) = 1._wp
107	END DO
108	!
109	!MAV temporary code for 3.5
110	REWIND( numnat ) ! read nattrc
111	READ ( numnat, namtrc_dta )
112	!MAV future code for 3.6
113	! REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer data
114	! READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
115	!901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )
116	!
117	! REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer data
118	! READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
119	!902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )
120	! WRITE ( numont, namtrc_dta )
121
122	IF( lwp ) THEN
123	DO jn = 1, ntrc
124	IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true
125	clndta = TRIM( sn_trcdta(jn)%clvar )
126	clntrc = TRIM( ctrcnm (jn) )
127	zfact = rn_trfac(jn)
128	IF( clndta /= clntrc ) THEN
129	CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation : ', &
130	& 'the variable name in the data file : '//clndta// &
131	& ' must be the same than the name of the passive tracer : '//clntrc//' ')
132	ENDIF
133	WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &
134	& ' multiplicative factor : ', zfact
135	ENDIF
136	END DO
137	ENDIF
138	!
139	IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero
140	ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
141	IF( ierr1 > 0 ) THEN
142	CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN
143	ENDIF
144	!
145	DO jn = 1, ntrc
146	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
147	jl = n_trc_index(jn)
148	slf_i(jl) = sn_trcdta(jn)
149	rf_trfac(jl) = rn_trfac(jn)
150	ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
151	IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
152	IF( ierr2 + ierr3 > 0 ) THEN
153	CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN
154	ENDIF
155	ENDIF
156	!
157	ENDDO
158	! ! fill sf_trcdta with slf_i and control print
159	CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
160	!
161	ENDIF
162	!
163	DEALLOCATE( slf_i ) ! deallocate local field structure
164	IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init')
165	!
166	END SUBROUTINE trc_dta_init
167
168
169	SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
170	!!----------------------------------------------------------------------
171	!! * ROUTINE trc_dta *
172	!!
173	!! ** Purpose : provides passive tracer data at kt
174	!!
175	!! ** Method : - call fldread routine
176	!! - s- or mixed z-s coordinate: vertical interpolation on model mesh
177	!! - ln_trcdmp=F: deallocates the data structure as they are not used
178	!!
179	!! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt
180	!!----------------------------------------------------------------------
181	INTEGER , INTENT(in ) :: kt ! ocean time-step
182	TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read
183	REAL(wp) , INTENT(in ) :: zrf_trfac ! multiplication factor
184	!
185	INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices
186	REAL(wp):: zl, zi
187	REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace
188	CHARACTER(len=100) :: clndta
189	!!----------------------------------------------------------------------
190	!
191	IF( nn_timing == 1 ) CALL timing_start('trc_dta')
192	!
193	IF( nb_trcdta > 0 ) THEN
194	!
195	CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==!
196	!
197	IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
198	!
199	IF( kt == nit000 .AND. lwp )THEN
200	WRITE(numout,*)
201	WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
202	ENDIF
203	!
204	DO jj = 1, jpj ! vertical interpolation of T & S
205	DO ji = 1, jpi
206	DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points
207	zl = fsdept_0(ji,jj,jk)
208	IF( zl < gdept_0(1 ) ) THEN ! above the first level of data
209	ztp(jk) = sf_dta(1)%fnow(ji,jj,1)
210	ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data
211	ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1)
212	ELSE ! inbetween : vertical interpolation between jkk & jkk+1
213	DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1)
214	IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN
215	zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk))
216	ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
217	sf_dta(1)%fnow(ji,jj,jkk) ) * zi
218	ENDIF
219	END DO
220	ENDIF
221	END DO
222	DO jk = 1, jpkm1
223	sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord
224	END DO
225	sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
226	END DO
227	END DO
228	!
229	ELSE !== z- or zps- coordinate ==!
230	!
231	sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask
232	!
233	IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level
234	DO jj = 1, jpj
235	DO ji = 1, jpi
236	ik = mbkt(ji,jj)
237	IF( ik > 1 ) THEN
238	zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
239	sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
240	ENDIF
241	END DO
242	END DO
243	ENDIF
244	!
245	ENDIF
246	!
247	sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor
248	!
249	IF( lwp .AND. kt == nit000 ) THEN
250	clndta = TRIM( sf_dta(1)%clvar )
251	WRITE(numout,*) ''//clndta//' data '
252	WRITE(numout,*)
253	WRITE(numout,*)' level = 1'
254	CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
255	WRITE(numout,*)' level = ', jpk/2
256	CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
257	WRITE(numout,*)' level = ', jpkm1
258	CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
259	WRITE(numout,*)
260	ENDIF
261	ENDIF
262	!
263	IF( nn_timing == 1 ) CALL timing_stop('trc_dta')
264	!
265	END SUBROUTINE trc_dta
266	#else
267	!!----------------------------------------------------------------------
268	!! Dummy module NO 3D passive tracer data
269	!!----------------------------------------------------------------------
270	CONTAINS
271	SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) ! Empty routine
272	WRITE(,) 'trc_dta: You should not have seen this print! error?', kt
273	END SUBROUTINE trc_dta
274	#endif
275	!!======================================================================
276	END MODULE trcdta

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

Download in other formats: