Context Navigation

diaptr.F90 @ 2399

Last change on this file since 2399 was 2399, checked in by gm, 13 years ago
v3.3beta: diaptr (poleward heat & salt transports) #759 : rewriting including dynamical allocation + DOCTOR names
Property svn:keywords set to `Id`
File size: 40.2 KB

Line
1	MODULE diaptr
2	!!======================================================================
3	!! * MODULE diaptr *
4	!! Ocean physics: Computes meridonal transports and zonal means
5	!!=====================================================================
6	!! History : 1.0 ! 2003-09 (C. Talandier, G. Madec) Original code
7	!! 2.0 ! 2006-01 (A. Biastoch) Allow sub-basins computation
8	!! 3.2 ! 2010-03 (O. Marti, S. Flavoni) Add fields
9	!! 3.3 ! 2010-10 (G. Madec) dynamical allocation
10	!!----------------------------------------------------------------------
11
12	!!----------------------------------------------------------------------
13	!! dia_ptr : Poleward Transport Diagnostics module
14	!! dia_ptr_init : Initialization, namelist read
15	!! dia_ptr_wri : Output of poleward fluxes
16	!! ptr_vjk : "zonal" sum computation of a "meridional" flux array
17	!! ptr_tjk : "zonal" mean computation of a tracer field
18	!! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array
19	!! (Generic interface to ptr_vj_3d, ptr_vj_2d)
20	!!----------------------------------------------------------------------
21	USE oce ! ocean dynamics and active tracers
22	USE dom_oce ! ocean space and time domain
23	USE phycst ! physical constants
24	USE ldftra_oce ! ocean active tracers: lateral physics
25	USE dianam !
26	USE iom ! IOM library
27	USE ioipsl ! IO-IPSL library
28	USE in_out_manager ! I/O manager
29	USE lib_mpp ! MPP library
30	USE lbclnk ! lateral boundary condition - processor exchanges
31
32	IMPLICIT NONE
33	PRIVATE
34
35	INTERFACE ptr_vj
36	MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
37	END INTERFACE
38
39	PUBLIC dia_ptr_init ! call in opa module
40	PUBLIC dia_ptr ! call in step module
41	PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines
42	PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines
43
44	! !! namelist namptr
45	LOGICAL , PUBLIC :: ln_diaptr = .FALSE. !: Poleward transport flag (T) or not (F)
46	LOGICAL , PUBLIC :: ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation
47	LOGICAL , PUBLIC :: ln_diaznl = .FALSE. !: Add zonal means and meridional stream functions
48	LOGICAL , PUBLIC :: ln_ptrcomp = .FALSE. !: Add decomposition : overturning (and gyre, soon ...)
49	INTEGER , PUBLIC :: nn_fptr = 15 !: frequency of ptr computation [time step]
50	INTEGER , PUBLIC :: nn_fwri = 15 !: frequency of ptr outputs [time step]
51
52	REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.)
53	REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.)
54
55	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: btmsk ! T-point basin interior masks
56	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: btm30 ! mask out Southern Ocean (=0 south of 30°S)
57	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr , str ! adv heat and salt transports (approx)
58	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function
59	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk , r1_sjk ! i-mean i-k-surface and its inverse
60	#if defined key_diaeiv
61	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv')
62	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv')
63	#endif
64
65	INTEGER :: niter !
66	INTEGER :: nidom_ptr !
67	INTEGER :: numptr ! logical unit for Poleward TRansports
68	INTEGER :: nptr ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T)
69
70	REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup
71	REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rau0 x Cp)
72	REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg
73
74	!! * Substitutions
75	# include "domzgr_substitute.h90"
76	# include "vectopt_loop_substitute.h90"
77	!!----------------------------------------------------------------------
78	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
79	!! $Id$
80	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
81	!!----------------------------------------------------------------------
82	CONTAINS
83
84	FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval )
85	!!----------------------------------------------------------------------
86	!! * ROUTINE ptr_vj_3d *
87	!!
88	!! ** Purpose : i-k sum computation of a j-flux array
89	!!
90	!! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
91	!! pva is supposed to be a masked flux (i.e. * vmaske1ve3v)
92	!!
93	!! ** Action : - p_fval: i-k-mean poleward flux of pva
94	!!----------------------------------------------------------------------
95	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
96	!!
97	INTEGER :: ji, jj, jk ! dummy loop arguments
98	INTEGER :: ijpj ! ???
99	REAL(wp), DIMENSION(jpj) :: p_fval ! function value
100	!!--------------------------------------------------------------------
101	!
102	ijpj = jpj
103	p_fval(:) = 0._wp
104	DO jk = 1, jpkm1
105	DO jj = 2, jpjm1
106	DO ji = fs_2, fs_jpim1 ! Vector opt.
107	p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)
108	END DO
109	END DO
110	END DO
111	!
112	#if defined key_mpp_mpi
113	CALL mpp_sum( p_fval, ijpj, ncomm_znl)
114	#endif
115	!
116	END FUNCTION ptr_vj_3d
117
118
119	FUNCTION ptr_vj_2d( pva ) RESULT ( p_fval )
120	!!----------------------------------------------------------------------
121	!! * ROUTINE ptr_vj_2d *
122	!!
123	!! ** Purpose : "zonal" and vertical sum computation of a i-flux array
124	!!
125	!! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
126	!! pva is supposed to be a masked flux (i.e. * vmaske1ve3v)
127	!!
128	!! ** Action : - p_fval: i-k-mean poleward flux of pva
129	!!----------------------------------------------------------------------
130	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point
131	!!
132	INTEGER :: ji,jj ! dummy loop arguments
133	INTEGER :: ijpj ! ???
134	REAL(wp), DIMENSION(jpj) :: p_fval ! function value
135	!!--------------------------------------------------------------------
136	!
137	ijpj = jpj
138	p_fval(:) = 0._wp
139	DO jj = 2, jpjm1
140	DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
141	p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
142	END DO
143	END DO
144	!
145	#if defined key_mpp_mpi
146	CALL mpp_sum( p_fval, ijpj, ncomm_znl )
147	#endif
148	!
149	END FUNCTION ptr_vj_2d
150
151
152	FUNCTION ptr_vjk( pva, pmsk ) RESULT ( p_fval )
153	!!----------------------------------------------------------------------
154	!! * ROUTINE ptr_vjk *
155	!!
156	!! ** Purpose : i-sum computation of a j-velocity array
157	!!
158	!! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i).
159	!! pva is supposed to be a masked flux (i.e. * vmask)
160	!!
161	!! ** Action : - p_fval: i-mean poleward flux of pva
162	!!----------------------------------------------------------------------
163	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
164	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask
165	!!
166	INTEGER :: ji, jj, jk ! dummy loop arguments
167	REAL(wp), DIMENSION(jpj,jpk) :: p_fval ! return function value
168	#if defined key_mpp_mpi
169	INTEGER, DIMENSION(1) :: ish
170	INTEGER, DIMENSION(2) :: ish2
171	REAL(wp), DIMENSION(jpj*jpk) :: zwork ! 1D workspace
172	#endif
173	!!--------------------------------------------------------------------
174	!
175	p_fval(:,:) = 0._wp
176	!
177	IF( PRESENT( pmsk ) ) THEN
178	DO jk = 1, jpkm1
179	DO jj = 2, jpjm1
180	!!gm here, use of tmask_i ==> no need of loop over nldi, nlei....
181	DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
182	p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj)
183	END DO
184	END DO
185	END DO
186	ELSE
187	DO jk = 1, jpkm1
188	DO jj = 2, jpjm1
189	DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
190	p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj)
191	END DO
192	END DO
193	END DO
194	END IF
195	!
196	#if defined key_mpp_mpi
197	ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk
198	zwork(:) = RESHAPE( p_fval, ish )
199	CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )
200	p_fval(:,:) = RESHAPE( zwork, ish2 )
201	#endif
202	!
203	END FUNCTION ptr_vjk
204
205
206	FUNCTION ptr_tjk( pta, pmsk ) RESULT ( p_fval )
207	!!----------------------------------------------------------------------
208	!! * ROUTINE ptr_tjk *
209	!!
210	!! ** Purpose : i-sum computation of e1te3t a tracer field
211	!!
212	!! ** Method : - i-sum of mj(pta) using tmask
213	!!
214	!! ** Action : - p_fval: i-sum of e1te3tpta
215	!!----------------------------------------------------------------------
216	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point
217	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask
218	!!
219	INTEGER :: ji, jj, jk ! dummy loop arguments
220	REAL(wp),DIMENSION(jpj,jpk) :: p_fval ! return function value
221	#if defined key_mpp_mpi
222	INTEGER, DIMENSION(1) :: ish
223	INTEGER, DIMENSION(2) :: ish2
224	REAL(wp),DIMENSION(jpj*jpk) :: zwork ! 1D workspace
225	#endif
226	!!--------------------------------------------------------------------
227	!
228	p_fval(:,:) = 0._wp
229	DO jk = 1, jpkm1
230	DO jj = 2, jpjm1
231	DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
232	p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
233	END DO
234	END DO
235	END DO
236	#if defined key_mpp_mpi
237	ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk
238	zwork(:)= RESHAPE( p_fval, ish )
239	CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )
240	p_fval(:,:)= RESHAPE( zwork, ish2 )
241	#endif
242	!
243	END FUNCTION ptr_tjk
244
245
246	SUBROUTINE dia_ptr( kt )
247	!!----------------------------------------------------------------------
248	!! * ROUTINE dia_ptr *
249	!!----------------------------------------------------------------------
250	USE oce, vt => ua ! use ua as workspace
251	USE oce, vs => ua ! use ua as workspace
252	!!
253	INTEGER, INTENT(in) :: kt ! ocean time step index
254	!
255	INTEGER :: ji, jj, jk, jn ! dummy loop indices
256	REAL(wp) :: zv ! local scalar
257	!!----------------------------------------------------------------------
258	!
259	IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN
260	!
261	IF( MOD( kt, nn_fptr ) == 0 ) THEN
262	!
263	IF( ln_diaznl ) THEN ! i-mean temperature and salinity
264	DO jn = 1, nptr
265	tn_jk(:,:,jn) = ptr_tjk( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
266	END DO
267	ENDIF
268	!
269	! ! horizontal integral and vertical dz
270	! ! eulerian velocity
271	v_msf(:,:,1) = ptr_vjk( vn(:,:,:) )
272	DO jn = 2, nptr
273	v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) )
274	END DO
275	#if defined key_diaeiv
276	DO jn = 1, nptr ! bolus velocity
277	v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv
278	END DO
279	! ! add bolus stream-function to the eulerian one
280	v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:)
281	#endif
282	!
283	! ! Transports
284	! ! local heat & salt transports at T-points ( tn*mj[vn+v_eiv] )
285	vt(:,:,jpk) = 0._wp ; vs(:,:,jpk) = 0._wp
286	DO jk= 1, jpkm1
287	DO jj = 2, jpj
288	DO ji = 1, jpi
289	#if defined key_diaeiv
290	zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + u_eiv(ji,jj,jk) + u_eiv(ji,jj-1,jk) ) * 0.5_wp
291	#else
292	zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp
293	#endif
294	vt(:,jj,jk) = zv * tn(:,jj,jk)
295	vs(:,jj,jk) = zv * sn(:,jj,jk)
296	END DO
297	END DO
298	END DO
299	!!gm useless as overlap areas are not used in ptr_vjk
300	CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. )
301	!!gm
302	! ! heat & salt advective transports (approximation)
303	htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt ! SUM over jk + conversion
304	str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram
305	DO jn = 2, nptr
306	htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)btm30(:,:) ) , 2 ) rc_pwatt ! mask Southern Ocean
307	str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)btm30(:,:) ) , 2 ) rc_ggram ! mask Southern Ocean
308	END DO
309
310	IF( ln_ptrcomp ) THEN ! overturning transport
311	htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt ! SUM over jk + conversion
312	str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram
313	END IF
314	! ! Advective and diffusive transport
315	htr_adv(:) = htr_adv(:) * rc_pwatt ! these are computed in tra_adv... and tra_ldf... routines
316	htr_ldf(:) = htr_ldf(:) * rc_pwatt ! here just the conversion in PW and Gg
317	str_adv(:) = str_adv(:) * rc_ggram
318	str_ldf(:) = str_ldf(:) * rc_ggram
319
320	#if defined key_diaeiv
321	DO jn = 1, nptr ! Bolus component
322	htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk
323	str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk
324	END DO
325	#endif
326	! ! "Meridional" Stream-Function
327	DO jn = 1, nptr
328	DO jk = 2, jpk
329	v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function
330	#if defined key_diaeiv
331	v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function
332
333	#endif
334	END DO
335	END DO
336	v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups
337	#if defined key_diaeiv
338	v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv
339	#endif
340	ENDIF
341	!
342	CALL dia_ptr_wri( kt ) ! outputs
343	!
344	ENDIF
345	!
346	IF( kt == nitend ) CALL histclo( numptr ) ! Close the file
347	!
348	END SUBROUTINE dia_ptr
349
350
351	SUBROUTINE dia_ptr_init
352	!!----------------------------------------------------------------------
353	!! * ROUTINE dia_ptr_init *
354	!!
355	!! ** Purpose : Initialization, namelist read
356	!!----------------------------------------------------------------------
357	INTEGER :: jn ! dummy loop indices
358	INTEGER :: inum, ierr ! local integers
359	#if defined key_mpp_mpi
360	INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
361	#endif
362	!!
363	NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri
364	!!----------------------------------------------------------------------
365
366	REWIND( numnam ) ! Read Namelist namptr : poleward transport parameters
367	READ ( numnam, namptr )
368
369	IF(lwp) THEN ! Control print
370	WRITE(numout,*)
371	WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
372	WRITE(numout,*) '~~~~~~~~~~~~'
373	WRITE(numout,*) ' Namelist namptr : set ptr parameters'
374	WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr
375	WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp
376	WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl
377	WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas
378	WRITE(numout,*) ' Frequency of computation nn_fptr = ', nn_fptr
379	WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri
380	ENDIF
381
382	IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific
383	ELSE ; nptr = 1 ! Global only
384	ENDIF
385
386	rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt
387
388	IF( .NOT. ln_diaptr ) THEN ! diaptr not used
389	RETURN
390	ELSE ! Allocate the diaptr arrays
391	ALLOCATE( btmsk(jpi,jpj,nptr) , &
392	& htr_adv(jpj) , str_adv(jpj) , htr_ldf(jpj) , str_ldf(jpj) , htr_ove(jpj) , str_ove(jpj), &
393	& htr(jpj,nptr) , str(jpj,nptr) , &
394	& tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &
395	& sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr )
396	!
397	IF( ierr > 0 ) THEN
398	CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' ) ; RETURN
399	ENDIF
400	#if defined key_diaeiv
401	!! IF( lk_diaeiv ) & ! eddy induced velocity arrays
402	ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr )
403	!
404	IF( ierr > 0 ) THEN
405	CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' ) ; RETURN
406	ENDIF
407	#endif
408	ENDIF
409
410	IF( lk_mpp ) CALL mpp_ini_znl ! Define MPI communicator for zonal sum
411
412	IF( ln_subbas ) THEN ! load sub-basin mask
413	CALL iom_open( 'subbasins', inum )
414	CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin
415	CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin
416	CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin
417	CALL iom_close( inum )
418	btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin
419	WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean
420	ELSE WHERE ; btm30(:,:) = tmask(:,:,1)
421	END WHERE
422	ENDIF
423	btmsk(:,:,1) = tmask_i(:,:) ! global ocean
424
425	DO jn = 1, nptr
426	btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only
427	END DO
428
429	IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' )
430
431	! ! i-sum of e1v*e3v surface and its inverse
432	DO jn = 1, nptr
433	sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) )
434	r1_sjk(:,:,jn) = 0._wp
435	WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
436	END DO
437
438	#if defined key_mpp_mpi
439	iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi')
440	iloc (1) = nlcj
441	iabsf(1) = njmppt(narea)
442	iabsl(:) = iabsf(:) + iloc(:) - 1
443	ihals(1) = nldj - 1
444	ihale(1) = nlcj - nlej
445	idid (1) = 2
446	CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )
447	#else
448	nidom_ptr = FLIO_DOM_NONE
449	#endif
450	!
451	END SUBROUTINE dia_ptr_init
452
453
454	SUBROUTINE dia_ptr_wri( kt )
455	!!---------------------------------------------------------------------
456	!! * ROUTINE dia_ptr_wri *
457	!!
458	!! ** Purpose : output of poleward fluxes
459	!!
460	!! ** Method : NetCDF file
461	!!----------------------------------------------------------------------
462	INTEGER, INTENT(in) :: kt ! ocean time-step index
463	!!
464	INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw
465	INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc
466	INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30
467	INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30
468	INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc
469	INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30
470	INTEGER, SAVE, DIMENSION (jpj) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
471	!!
472	CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names
473	INTEGER :: iline, it, itmod, ji, jj, jk !
474	#if defined key_iomput
475	INTEGER :: inum ! temporary logical unit
476	#endif
477	REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars
478	REAL(wp), DIMENSION(jpj) :: zphi, zfoo
479	REAL(wp), DIMENSION(jpj,jpk) :: z_1
480	!!----------------------------------------------------------------------
481
482	! define time axis
483	it = kt / nn_fptr
484	itmod = kt - nit000 + 1
485
486	! Initialization
487	! --------------
488	IF( kt == nit000 ) THEN
489	niter = ( nit000 - 1 ) / nn_fptr
490	zdt = rdt
491	IF( nacc == 1 ) zdt = rdtmin
492	!
493	IF(lwp) THEN
494	WRITE(numout,*)
495	WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
496	WRITE(numout,*) '~~~~~~~~~~~~'
497	ENDIF
498
499	! Reference latitude (used in plots)
500	! ------------------
501	! ! =======================
502	IF( cp_cfg == "orca" ) THEN ! ORCA configurations
503	! ! =======================
504	IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole
505	IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole
506	IF( jp_cfg == 1 ) iline = 96 ! i-line that passes near the North Pole
507	IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole
508	IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole
509	zphi(:) = 0._wp
510	DO ji = mi0(iline), mi1(iline)
511	zphi(:) = gphiv(ji,:) ! if iline is in the local domain
512	! Correct highest latitude for some configurations - will work if domain is parallelized in J ?
513	IF( jp_cfg == 05 ) THEN
514	DO jj = mj0(jpjdta), mj1(jpjdta)
515	zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp
516	zphi( jj ) = MIN( zphi(jj), 90._wp )
517	END DO
518	END IF
519	IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
520	DO jj = mj0(jpjdta-1), mj1(jpjdta-1)
521	zphi( jj ) = 88.5_wp
522	END DO
523	DO jj = mj0(jpjdta ), mj1(jpjdta )
524	zphi( jj ) = 89.5_wp
525	END DO
526	END IF
527	END DO
528	! provide the correct zphi to all local domains
529	#if defined key_mpp_mpi
530	CALL mpp_sum( zphi, jpj, ncomm_znl )
531	#endif
532	! ! =======================
533	ELSE ! OTHER configurations
534	! ! =======================
535	zphi(:) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line
536	!
537	ENDIF
538	!
539	! Work only on westmost processor (will not work if mppini2 is used)
540	#if defined key_mpp_mpi
541	IF( l_znl_root ) THEN
542	#endif
543	!
544	! OPEN netcdf file
545	! ----------------
546	! Define frequency of output and means
547	zsto = nn_fptr * zdt
548	IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!)
549	clop = "ave(only(x))"
550	clop_once = "once(only(x))"
551	ELSE ! no use of the mask value (require less cpu time)
552	clop = "ave(x)"
553	clop_once = "once"
554	ENDIF
555
556	zout = nn_fwri * zdt
557	zfoo(:) = 0._wp
558
559	! Compute julian date from starting date of the run
560
561	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
562	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
563
564	#if defined key_iomput
565	! Requested by IPSL people, use by their postpro...
566	IF(lwp) THEN
567	CALL dia_nam( clhstnam, nn_fwri,' ' )
568	CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
569	WRITE(inum,*) clhstnam
570	CLOSE(inum)
571	ENDIF
572	#endif
573
574	CALL dia_nam( clhstnam, nn_fwri, 'diaptr' )
575	IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam
576
577	! Horizontal grid : zphi()
578	CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, &
579	1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr)
580	! Vertical grids : gdept_0, gdepw_0
581	CALL histvert( numptr, "deptht", "Vertical T levels", &
582	& "m", jpk, gdept_0, ndepidzt, "down" )
583	CALL histvert( numptr, "depthw", "Vertical W levels", &
584	& "m", jpk, gdepw_0, ndepidzw, "down" )
585
586	!
587	CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth
588	CALL wheneq ( jpj , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h ) ! Lat
589
590	IF( ln_subbas ) THEN
591	z_1(:,1) = 1._wp
592	WHERE ( gphit(jpi/2,:) < -30._wp ) z_1(:,1) = 0._wp
593	DO jk = 2, jpk
594	z_1(:,jk) = z_1(:,1)
595	END DO
596	! ! Atlantic (jn=2)
597	CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2) , 1._wp), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth
598	CALL wheneq ( jpjjpk, MIN(sjk(:,:,2)z_1(:,:), 1._wp), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth
599	CALL wheneq ( jpj , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
600	! ! Pacific (jn=3)
601	CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3) , 1._wp), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth
602	CALL wheneq ( jpjjpk, MIN(sjk(:,:,3)z_1(:,:), 1._wp), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth
603	CALL wheneq ( jpj , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
604	! ! Indian (jn=4)
605	CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4) , 1._wp), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth
606	CALL wheneq ( jpjjpk, MIN(sjk(:,:,4)z_1(:,:), 1._wp), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth
607	CALL wheneq ( jpj , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
608	! ! Indo-Pacific (jn=5)
609	CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5) , 1._wp), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth
610	CALL wheneq ( jpjjpk, MIN(sjk(:,:,5)z_1(:,:), 1._wp), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth
611	CALL wheneq ( jpj , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
612	ENDIF
613	!
614	#if defined key_diaeiv
615	cl_comment = ' (Bolus part included)'
616	#else
617	cl_comment = ' '
618	#endif
619	! Zonal mean T and S
620
621	IF( ln_diaznl ) THEN
622	CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , &
623	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
624	CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , &
625	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
626
627	CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , &
628	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
629
630	IF (ln_subbas) THEN
631	CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , &
632	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
633	CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , &
634	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
635	CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , &
636	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
637
638	CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , &
639	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
640	CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , &
641	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
642	CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , &
643	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
644
645	CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , &
646	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
647	CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , &
648	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
649	CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , &
650	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
651
652	CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , &
653	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
654	CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , &
655	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
656	CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , &
657	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
658	ENDIF
659
660	ENDIF
661
662	! Meridional Stream-Function (Eulerian and Bolus)
663
664	CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , &
665	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
666	IF( ln_subbas .AND. ln_diaznl ) THEN
667	CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , &
668	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
669	CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , &
670	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
671	CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , &
672	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
673	CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,&
674	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
675	ENDIF
676
677	! Heat transport
678
679	CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , &
680	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
681	CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , &
682	"PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
683	IF ( ln_ptrcomp ) THEN
684	CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , &
685	"PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
686	END IF
687	IF( ln_subbas ) THEN
688	CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), &
689	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
690	CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , &
691	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
692	CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , &
693	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
694	CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), &
695	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
696	ENDIF
697
698
699	! Salt transport
700
701	CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , &
702	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
703	CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , &
704	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
705	IF ( ln_ptrcomp ) THEN
706	CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , &
707	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
708	END IF
709	#if defined key_diaeiv
710	! Eddy induced velocity
711	CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", &
712	"Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
713	CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", &
714	"PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
715	CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", &
716	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
717	#endif
718	IF( ln_subbas ) THEN
719	CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , &
720	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
721	CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , &
722	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
723	CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , &
724	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
725	CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), &
726	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
727	ENDIF
728
729	CALL histend( numptr )
730
731	END IF
732	#if defined key_mpp_mpi
733	END IF
734	#endif
735
736	#if defined key_mpp_mpi
737	IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN
738	#else
739	IF( MOD( itmod, nn_fptr ) == 0 ) THEN
740	#endif
741	niter = niter + 1
742
743	IF( ln_diaznl ) THEN
744	CALL histwrite( numptr, "zosrfglo", niter, sjk (:,:,1) , ndim, ndex )
745	CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1) , ndim, ndex )
746	CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1) , ndim, ndex )
747
748	IF (ln_subbas) THEN
749	CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl )
750	CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac )
751	CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind )
752	CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc )
753
754	CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2) , ndim_atl, ndex_atl )
755	CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2) , ndim_atl, ndex_atl )
756	CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3) , ndim_pac, ndex_pac )
757	CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3) , ndim_pac, ndex_pac )
758	CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4) , ndim_ind, ndex_ind )
759	CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4) , ndim_ind, ndex_ind )
760	CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5) , ndim_ipc, ndex_ipc )
761	CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5) , ndim_ipc, ndex_ipc )
762	END IF
763	ENDIF
764
765	! overturning outputs:
766	CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex )
767	IF( ln_subbas .AND. ln_diaznl ) THEN
768	CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 )
769	CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 )
770	CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 )
771	CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 )
772	ENDIF
773	#if defined key_diaeiv
774	CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim , ndex )
775	#endif
776
777	! heat transport outputs:
778	IF( ln_subbas ) THEN
779	CALL histwrite( numptr, "sohtatl", niter, htr(:,2) , ndim_h_atl_30, ndex_h_atl_30 )
780	CALL histwrite( numptr, "sohtpac", niter, htr(:,3) , ndim_h_pac_30, ndex_h_pac_30 )
781	CALL histwrite( numptr, "sohtind", niter, htr(:,4) , ndim_h_ind_30, ndex_h_ind_30 )
782	CALL histwrite( numptr, "sohtipc", niter, htr(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 )
783	CALL histwrite( numptr, "sostatl", niter, str(:,2) , ndim_h_atl_30, ndex_h_atl_30 )
784	CALL histwrite( numptr, "sostpac", niter, str(:,3) , ndim_h_pac_30, ndex_h_pac_30 )
785	CALL histwrite( numptr, "sostind", niter, str(:,4) , ndim_h_ind_30, ndex_h_ind_30 )
786	CALL histwrite( numptr, "sostipc", niter, str(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 )
787	ENDIF
788
789	CALL histwrite( numptr, "sophtadv", niter, htr_adv , ndim_h, ndex_h )
790	CALL histwrite( numptr, "sophtldf", niter, htr_ldf , ndim_h, ndex_h )
791	CALL histwrite( numptr, "sopstadv", niter, str_adv , ndim_h, ndex_h )
792	CALL histwrite( numptr, "sopstldf", niter, str_ldf , ndim_h, ndex_h )
793	IF( ln_ptrcomp ) THEN
794	CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h )
795	CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h )
796	ENDIF
797	#if defined key_diaeiv
798	CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1) , ndim_h, ndex_h )
799	CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1) , ndim_h, ndex_h )
800	#endif
801	!
802	ENDIF
803	!
804	END SUBROUTINE dia_ptr_wri
805
806	!!======================================================================
807	END MODULE diaptr

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

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

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90 @ 2399

Download in other formats: