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.

diaptr.F90 in trunk/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/DIA/diaptr.F90 @ 1317

Last change on this file since 1317 was 1317, checked in by smasson, 15 years ago
nwrite = modulo referenced to nit000 in all ouputs, see ticket:339
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 26.1 KB

Line
1	MODULE diaptr
2	!!======================================================================
3	!! * MODULE diaptr *
4	!! Ocean physics: brief description of the purpose of the module
5	!! (please no more than 2 lines)
6	!!=====================================================================
7	!! History : 9.0 ! 03-09 (C. Talandir, G. Madec) Original code
8	!! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation
9	!!----------------------------------------------------------------------
10
11	!!----------------------------------------------------------------------
12	!! dia_ptr : Poleward Transport Diagnostics module
13	!! dia_ptr_init : Initialization, namelist read
14	!! dia_ptr_wri : Output of poleward fluxes
15	!! ptr_vjk : "zonal" sum computation of a "meridional" flux array
16	!! ptr_vtjk : "zonal" mean computation of a tracer field
17	!! ptr_vj : "zonal" and vertical sum computation of a "meridional"
18	!! : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d
19	!!----------------------------------------------------------------------
20	USE oce ! ocean dynamics and active tracers
21	USE dom_oce ! ocean space and time domain
22	USE ldftra_oce ! ???
23	USE lib_mpp
24	USE in_out_manager
25	USE dianam
26	USE phycst
27	USE iom
28	USE ioipsl
29	USE daymod
30
31	IMPLICIT NONE
32	PRIVATE
33
34	INTERFACE ptr_vj
35	MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
36	END INTERFACE
37
38	PUBLIC dia_ptr_init ! call in opa module
39	PUBLIC dia_ptr ! call in step module
40	PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines
41	PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines
42
43	!!! ** init namelist (namptr)
44	LOGICAL , PUBLIC :: ln_diaptr = .FALSE. !: Poleward transport flag (T) or not (F)
45	LOGICAL , PUBLIC :: ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation
46	INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation
47
48	REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection
49	REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove, pst_ove !: heat and salt poleward transport: overturning
50	REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf, pst_ldf !: heat and salt poleward transport: lateral diffusion
51	#if defined key_diaeiv
52	REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv, pst_eiv !: heat and salt poleward transport: bolus advection
53	#endif
54	REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_atl,ht_ind,ht_pac !: heat
55	REAL(wp), PUBLIC, DIMENSION(jpj) :: st_atl,st_ind,st_pac !: salt
56
57
58
59	REAL(wp), DIMENSION(jpj,jpk) :: tn_jk , sn_jk , & !: "zonal" mean temperature and salinity
60	& v_msf_atl , & !: "meridional" Stream-Function
61	& v_msf_glo , & !: "meridional" Stream-Function
62	& v_msf_ipc , & !: "meridional" Stream-Function
63	& surf_jk_r !: inverse of the ocean "zonal" section surface
64	#if defined key_diaeiv
65	REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv !: bolus "meridional" Stream-Function
66	#endif
67	REAL(wp), DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin !: return function value
68
69	!! * Substitutions
70	# include "domzgr_substitute.h90"
71	# include "vectopt_loop_substitute.h90"
72	!!----------------------------------------------------------------------
73	!! OPA 9.0 , LOCEAN-IPSL (2005)
74	!! $Id$
75	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
76	!!----------------------------------------------------------------------
77
78	CONTAINS
79
80	FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval )
81	!!----------------------------------------------------------------------
82	!! * ROUTINE ptr_vj_3d *
83	!!
84	!! ** Purpose : "zonal" and vertical sum computation of a "meridional"
85	!! flux array
86	!!
87	!! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
88	!! pva is supposed to be a masked flux (i.e. * vmaske1ve3v)
89	!!
90	!! ** Action : - p_fval: i-k-mean poleward flux of pva
91	!!----------------------------------------------------------------------
92	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
93	!!
94	INTEGER :: ji, jj, jk ! dummy loop arguments
95	INTEGER :: ijpj ! ???
96	REAL(wp), DIMENSION(jpj) :: p_fval ! function value
97	!!--------------------------------------------------------------------
98	!
99	ijpj = jpj
100	p_fval(:) = 0.e0
101	DO jk = 1, jpkm1
102	DO jj = 2, jpjm1
103	DO ji = fs_2, fs_jpim1 ! Vector opt.
104	p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj)
105	END DO
106	END DO
107	END DO
108	!
109	IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume
110	!
111	END FUNCTION ptr_vj_3d
112
113
114	FUNCTION ptr_vj_2d( pva ) RESULT ( p_fval )
115	!!----------------------------------------------------------------------
116	!! * ROUTINE ptr_vj_2d *
117	!!
118	!! ** Purpose : "zonal" and vertical sum computation of a "meridional"
119	!! flux array
120	!!
121	!! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
122	!! pva is supposed to be a masked flux (i.e. * vmaske1ve3v)
123	!!
124	!! ** Action : - p_fval: i-k-mean poleward flux of pva
125	!!----------------------------------------------------------------------
126	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point
127	!!
128	INTEGER :: ji,jj ! dummy loop arguments
129	INTEGER :: ijpj ! ???
130	REAL(wp), DIMENSION(jpj) :: p_fval ! function value
131	!!--------------------------------------------------------------------
132	!
133	ijpj = jpj
134	p_fval(:) = 0.e0
135	DO jj = 2, jpjm1
136	DO ji = fs_2, fs_jpim1 ! Vector opt.
137	p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj+1) * tmask_i(ji,jj)
138	END DO
139	END DO
140	!
141	IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume
142	!
143	END FUNCTION ptr_vj_2d
144
145
146	FUNCTION ptr_vjk( pva ) RESULT ( p_fval )
147	!!----------------------------------------------------------------------
148	!! * ROUTINE ptr_vjk *
149	!!
150	!! ** Purpose : "zonal" sum computation of a "meridional" flux array
151	!!
152	!! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i).
153	!! pva is supposed to be a masked flux (i.e. * vmaske1ve3v)
154	!!
155	!! ** Action : - p_fval: i-k-mean poleward flux of pva
156	!!----------------------------------------------------------------------
157	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
158	!!
159	INTEGER :: ji, jj, jk ! dummy loop arguments
160	INTEGER , DIMENSION (1) :: ish
161	INTEGER , DIMENSION (2) :: ish2
162	REAL(wp), DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum
163	REAL(wp), DIMENSION(jpj,jpk) :: p_fval ! return function value
164	!!--------------------------------------------------------------------
165	!
166	p_fval(:,:) = 0.e0
167	!
168	DO jk = 1, jpkm1
169	DO jj = 2, jpjm1
170	DO ji = fs_2, fs_jpim1
171	p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) &
172	& * tmask_i(ji,jj+1) * tmask_i(ji,jj)
173	END DO
174	END DO
175	END DO
176	!
177	IF(lk_mpp) THEN
178	ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk
179	zwork(:)= RESHAPE( p_fval, ish )
180	CALL mpp_sum( zwork, jpj*jpk )
181	p_fval(:,:)= RESHAPE( zwork, ish2 )
182	END IF
183	!
184	END FUNCTION ptr_vjk
185
186
187	FUNCTION ptr_vtjk( pva ) RESULT ( p_fval )
188	!!----------------------------------------------------------------------
189	!! * ROUTINE ptr_vtjk *
190	!!
191	!! ** Purpose : "zonal" mean computation of a tracer field
192	!!
193	!! ** Method : - i-sum of mj(pva) using the interior 2D vmask (vmask_i)
194	!! multiplied by the inverse of the surface of the "zonal" ocean
195	!! section
196	!!
197	!! ** Action : - p_fval: i-k-mean poleward flux of pva
198	!!----------------------------------------------------------------------
199	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
200	!!
201	INTEGER :: ji, jj, jk ! dummy loop arguments
202	INTEGER, DIMENSION (1) :: ish
203	INTEGER, DIMENSION (2) :: ish2
204	REAL(wp),DIMENSION(jpj*jpk) :: zwork ! temporary vector for mpp_sum
205	REAL(wp),DIMENSION(jpj,jpk) :: p_fval ! return function value
206	!!--------------------------------------------------------------------
207	!
208	p_fval(:,:) = 0.e0
209	DO jk = 1, jpkm1
210	DO jj = 2, jpjm1
211	DO ji = fs_2, fs_jpim1 ! Vector opt.
212	p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj+1,jk) ) &
213	& * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) &
214	& * tmask_i(ji,jj+1) * tmask_i(ji,jj)
215	END DO
216	END DO
217	END DO
218	p_fval(:,:) = p_fval(:,:) * 0.5
219	IF(lk_mpp) THEN
220	ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk
221	zwork(:)= RESHAPE( p_fval, ish )
222	CALL mpp_sum( zwork, jpj*jpk )
223	p_fval(:,:)= RESHAPE(zwork,ish2)
224	END IF
225	!
226	END FUNCTION ptr_vtjk
227
228
229	SUBROUTINE dia_ptr( kt )
230	!!----------------------------------------------------------------------
231	!! * ROUTINE dia_ptr *
232	!!----------------------------------------------------------------------
233	INTEGER, INTENT(in) :: kt ! ocean time step index
234	!!
235	INTEGER :: jk, jj, ji ! dummy loop
236	REAL(wp) :: zsverdrup, & ! conversion from m3/s to Sverdrup
237	& zpwatt, & ! conversion from W to PW
238	& zggram ! conversion from g to Pg
239
240	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
241	v_atl , v_ipc, &
242	vt_atl, vt_pac, vt_ind, &
243	vs_atl, vs_pac, vs_ind
244	INTEGER :: inum ! temporary logical unit
245	!!----------------------------------------------------------------------
246
247	IF( kt == nit000 .OR. MOD( kt - nit000 + 1, nf_ptr ) == 0 ) THEN
248
249	zsverdrup = 1.e-6
250	zpwatt = 1.e-15
251	zggram = 1.e-6
252
253	! "zonal" mean temperature and salinity at V-points
254	tn_jk(:,:) = ptr_vtjk( tn(:,:,:) ) * surf_jk_r(:,:)
255	sn_jk(:,:) = ptr_vtjk( sn(:,:,:) ) * surf_jk_r(:,:)
256
257	!--------------------------------------------------------
258	! overturning calculation:
259
260	IF( ln_subbas ) THEN ! Basins computation
261
262	IF( kt == nit000 ) THEN ! load sub-basin mask
263	CALL iom_open( 'subbasins', inum )
264	CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin
265	CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin ) ! Pacific basin
266	CALL iom_get( inum, jpdom_data, 'indmsk', ibasin ) ! Indian basin
267	CALL iom_close( inum )
268	ENDIF
269
270	! basin separation:
271	DO jj = 1, jpj
272	DO ji = 1, jpi
273	! basin separated velocity
274	v_atl(ji,jj,:) = vn(ji,jj,:)*abasin(ji,jj)
275	v_ipc(ji,jj,:) = vn(ji,jj,:)*(pbasin(ji,jj)+ibasin(ji,jj))
276
277	! basin separated T times V on T points
278	vt_ind(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5
279	vt_atl(ji,jj,:) = vt_ind(ji,jj,:) * abasin(ji,jj)
280	vt_pac(ji,jj,:) = vt_ind(ji,jj,:) * pbasin(ji,jj)
281	vt_ind(ji,jj,:) = vt_ind(ji,jj,:) * ibasin(ji,jj)
282
283	! basin separated S times V on T points
284	vs_ind(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5
285	vs_atl(ji,jj,:) = vs_ind(ji,jj,:) * abasin(ji,jj)
286	vs_pac(ji,jj,:) = vs_ind(ji,jj,:) * pbasin(ji,jj)
287	vs_ind(ji,jj,:) = vs_ind(ji,jj,:) * ibasin(ji,jj)
288	END DO
289	END DO
290
291	ENDIF
292
293	! horizontal integral and vertical dz
294	v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) )
295	#if defined key_diaeiv
296	v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) )
297	#endif
298	IF( ln_subbas ) THEN
299	v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) )
300	v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) )
301	ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)), 2 )
302	ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)), 2 )
303	ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)), 2 )
304	st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)), 2 )
305	st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)), 2 )
306	st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)), 2 )
307	ENDIF
308
309	! poleward tracer transports:
310	! overturning components:
311	pht_ove(:) = SUM( v_msf_glo(:,:) * tn_jk(:,:), 2 ) ! SUM over jk
312	pst_ove(:) = SUM( v_msf_glo(:,:) * sn_jk(:,:), 2 ) ! SUM over jk
313	#if defined key_diaeiv
314	pht_eiv(:) = SUM( v_msf_eiv(:,:) * tn_jk(:,:), 2 ) ! SUM over jk
315	pst_eiv(:) = SUM( v_msf_eiv(:,:) * sn_jk(:,:), 2 ) ! SUM over jk
316	#endif
317
318	! conversion in PW and G g
319	zpwatt = zpwatt * rau0 * rcp
320	pht_adv(:) = pht_adv(:) * zpwatt
321	pht_ove(:) = pht_ove(:) * zpwatt
322	pht_ldf(:) = pht_ldf(:) * zpwatt
323	pst_adv(:) = pst_adv(:) * zggram
324	pst_ove(:) = pst_ove(:) * zggram
325	pst_ldf(:) = pst_ldf(:) * zggram
326	#if defined key_diaeiv
327	pht_eiv(:) = pht_eiv(:) * zpwatt
328	pst_eiv(:) = pst_eiv(:) * zggram
329	#endif
330	IF( ln_subbas ) THEN
331	ht_atl(:) = ht_atl(:) * zpwatt
332	ht_pac(:) = ht_pac(:) * zpwatt
333	ht_ind(:) = ht_ind(:) * zpwatt
334	st_atl(:) = st_atl(:) * zggram
335	st_pac(:) = st_pac(:) * zggram
336	st_ind(:) = st_ind(:) * zggram
337	ENDIF
338
339	! "Meridional" Stream-Function
340	DO jk = 2,jpk
341	v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk)
342	END DO
343	v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup
344
345	#if defined key_diaeiv
346	! Bolus "Meridional" Stream-Function
347	DO jk = 2,jpk
348	v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk)
349	END DO
350	v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup
351	#endif
352
353	IF( ln_subbas ) THEN
354	DO jk = 2,jpk
355	v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk)
356	v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk)
357	END DO
358	v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup
359	v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup
360	ENDIF
361
362	! outputs
363	CALL dia_ptr_wri( kt )
364
365	ENDIF
366
367	! Close the file
368	IF( kt == nitend ) CALL histclo( numptr )
369	!
370	END SUBROUTINE dia_ptr
371
372
373	SUBROUTINE dia_ptr_init
374	!!----------------------------------------------------------------------
375	!! * ROUTINE dia_ptr_init *
376	!!
377	!! ** Purpose : Initialization, namelist read
378	!!----------------------------------------------------------------------
379	REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_1 ! temporary workspace
380
381	NAMELIST/namptr/ ln_diaptr, ln_subbas, nf_ptr
382	!!----------------------------------------------------------------------
383
384	! Read Namelist namptr : poleward transport parameters
385	REWIND ( numnam )
386	READ ( numnam, namptr )
387
388	! Control print
389	IF(lwp) THEN
390	WRITE(numout,*)
391	WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
392	WRITE(numout,*) '~~~~~~~~~~~~'
393	WRITE(numout,*) ' Namelist namptr : set ptr parameters'
394	WRITE(numout,*) ' Switch for ptr diagnostic (T) or not (F) ln_diaptr = ', ln_diaptr
395	WRITE(numout,*) ' Atla/Paci/Ind basins computation ln_subbas = ', ln_subbas
396	WRITE(numout,*) ' Frequency of computation nf_ptr = ', nf_ptr
397	ENDIF
398
399	! inverse of the ocean "zonal" v-point section
400	z_1(:,:,:) = 1.e0
401	surf_jk_r(:,:) = ptr_vtjk( z_1(:,:,:) )
402	WHERE( surf_jk_r(:,:) /= 0.e0 ) surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:)
403
404	END SUBROUTINE dia_ptr_init
405
406
407	SUBROUTINE dia_ptr_wri( kt )
408	!!---------------------------------------------------------------------
409	!! * ROUTINE dia_ptr_wri *
410	!!
411	!! ** Purpose : output of poleward fluxes
412	!!
413	!! ** Method : NetCDF file
414	!!----------------------------------------------------------------------
415	INTEGER, INTENT(in) :: kt ! ocean time-step index
416	!!
417	INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw, ndex(1)
418
419	CHARACTER (len=40) :: clhstnam, clop ! temporary names
420	INTEGER :: iline, it, ji !
421	REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars
422	REAL(wp), DIMENSION(jpj) :: zphi, zfoo
423	!!----------------------------------------------------------------------
424
425	! define time axis
426	it = kt - nit000 + 1
427
428	! Initialization
429	! --------------
430	IF( kt == nit000 ) THEN
431
432	zdt = rdt
433	IF( nacc == 1 ) zdt = rdtmin
434
435	! Reference latitude
436	! ------------------
437	! ! =======================
438	IF( cp_cfg == "orca" ) THEN ! ORCA configurations
439	! ! =======================
440
441	IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole
442	IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole
443	IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole
444	IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole
445	zphi(:) = 0.e0
446	DO ji = mi0(iline), mi1(iline)
447	zphi(:) = gphiv(ji,:) ! if iline is in the local domain
448	! correct highest latitude for ORCA05
449	IF( jp_cfg == 05 ) zphi(jpj) = zphi(jpjm1) + (zphi(jpjm1)-zphi(jpj-2))/2.
450	IF( jp_cfg == 05 ) zphi(jpj) = MIN( zphi(jpj), 90.)
451
452	END DO
453	! provide the correct zphi to all local domains
454	IF( lk_mpp ) CALL mpp_sum( zphi, jpj )
455
456	! ! =======================
457	ELSE ! OTHER configurations
458	! ! =======================
459	zphi(:) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line
460	!
461	ENDIF
462
463	! OPEN netcdf file
464	! ----------------
465	! Define frequency of output and means
466	zsto = nf_ptr * zdt
467	IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!)
468	ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time)
469	ENDIF
470	zout = nf_ptr * zdt
471	zfoo(:) = 0.e0
472
473	! Compute julian date from starting date of the run
474
475	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
476	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
477
478	CALL dia_nam( clhstnam, nf_ptr, 'diaptr' )
479	IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam
480
481	! Horizontal grid : zphi()
482	CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, &
483	1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr, domain_id=nidom )
484	! Vertical grids : gdept_0, gdepw_0
485	CALL histvert( numptr, "deptht", "Vertical T levels", &
486	"m", jpk, gdept_0, ndepidzt )
487	CALL histvert( numptr, "depthw", "Vertical W levels", &
488	"m", jpk, gdepw_0, ndepidzw )
489
490	! Zonal mean T and S
491
492	CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , &
493	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
494	CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , &
495	1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
496
497	! Meridional Stream-Function (eulerian and bolus)
498
499	CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global","Sv" , &
500	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
501	IF( ln_subbas ) THEN
502	CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic","Sv" , &
503	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
504	CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific","Sv" ,&
505	1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
506	ENDIF
507
508	! Heat transport
509
510	CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , &
511	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
512	CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , &
513	"PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
514	CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , &
515	"PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
516	IF( ln_subbas ) THEN
517	CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic" , &
518	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
519	CALL histdef( numptr, "sohtpac", "Heat Transport Pacific" , &
520	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
521	CALL histdef( numptr, "sohtind", "Heat Transport Indic" , &
522	"PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
523	ENDIF
524
525
526	! Salt transport
527
528	CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , &
529	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
530	CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , &
531	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
532	CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , &
533	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
534
535	#if defined key_diaeiv
536	! Eddy induced velocity
537	CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", &
538	"Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
539	CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", &
540	"PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
541	CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", &
542	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
543	#endif
544	IF( ln_subbas ) THEN
545	CALL histdef( numptr, "sostatl", "Salt Transport Atlantic" , &
546	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
547	CALL histdef( numptr, "sostpac", "Salt Transport Pacific" , &
548	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
549	CALL histdef( numptr, "sostind", "Salt Transport Indic" , &
550	"Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
551	ENDIF
552
553	CALL histend( numptr )
554
555	ENDIF
556
557	IF( MOD( it, nf_ptr ) == 0 ) THEN
558
559	IF(lwp) THEN
560	WRITE(numout,*)
561	WRITE(numout,*) 'dia_ptr : write Poleward Transports at time-step : ', kt
562	WRITE(numout,*) '~~~~~~~~'
563	WRITE(numout,*)
564	ENDIF
565
566	ndex(1) = 0
567	CALL histwrite( numptr, "zotemglo", it, tn_jk , jpj*jpk, ndex )
568	CALL histwrite( numptr, "zosalglo", it, sn_jk , jpj*jpk, ndex )
569	! overturning outputs:
570	CALL histwrite( numptr, "zomsfglo", it, v_msf_glo , jpj*jpk, ndex )
571	IF( ln_subbas ) THEN
572	CALL histwrite( numptr, "zomsfatl", it, v_msf_atl , jpj*jpk, ndex )
573	CALL histwrite( numptr, "zomsfipc", it, v_msf_ipc , jpj*jpk, ndex )
574	ENDIF
575	! heat transport outputs:
576	IF( ln_subbas ) THEN
577	CALL histwrite( numptr, "sohtatl", it, ht_atl , jpj, ndex )
578	CALL histwrite( numptr, "sohtpac", it, ht_pac , jpj, ndex )
579	CALL histwrite( numptr, "sohtind", it, ht_ind , jpj, ndex )
580	CALL histwrite( numptr, "sostatl", it, st_atl , jpj, ndex )
581	CALL histwrite( numptr, "sostpac", it, st_pac , jpj, ndex )
582	CALL histwrite( numptr, "sostind", it, st_ind , jpj, ndex )
583	ENDIF
584
585	CALL histwrite( numptr, "sophtadv", it, pht_adv , jpj, ndex )
586	CALL histwrite( numptr, "sophtldf", it, pht_ldf , jpj, ndex )
587	CALL histwrite( numptr, "sophtove", it, pht_ove , jpj, ndex )
588	CALL histwrite( numptr, "sopstadv", it, pst_adv , jpj, ndex )
589	CALL histwrite( numptr, "sopstldf", it, pst_ldf , jpj, ndex )
590	CALL histwrite( numptr, "sopstove", it, pst_ove , jpj, ndex )
591	#if defined key_diaeiv
592	CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex )
593	CALL histwrite( numptr, "sophteiv", it, pht_eiv , jpj , ndex )
594	CALL histwrite( numptr, "sopsteiv", it, pst_eiv , jpj , ndex )
595	#endif
596
597	ENDIF
598	!
599	END SUBROUTINE dia_ptr_wri
600
601	!!======================================================================
602	END MODULE diaptr

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

Download in other formats: