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 @ 460

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

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

Download in other formats: