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

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

Last change on this file since 134 was 134, checked in by opalod, 20 years ago

CT : UPDATE082 : Finalization of the poleward transport diagnostics
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.9 KB
Line 
1MODULE 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   !! * Modules used
17   USE oce           ! ocean dynamics and active tracers
18   USE dom_oce       ! ocean space and time domain
19   USE ldftra_oce    ! ???
20   USE lib_mpp
21   USE in_out_manager
22   USE dianam
23   USE phycst
24
25   IMPLICIT NONE
26   PRIVATE
27
28   INTERFACE ptr_vj
29      MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
30   END INTERFACE
31
32   !! *  Routine accessibility
33   PUBLIC dia_ptr_init   ! call in opa module
34   PUBLIC dia_ptr        ! call in step module
35   PUBLIC ptr_vj         ! call by tra_ldf & tra_adv routines
36   PUBLIC ptr_vjk        ! call by tra_ldf & tra_adv routines
37
38   !! * Share Module variables
39   LOGICAL, PUBLIC ::   & !!! ** init namelist (namptr) **
40      ln_diaptr = .FALSE.   !: Poleward transport flag (T) or not (F)
41   INTEGER, PUBLIC ::   &  !!: ** ptr namelist (namptr) **
42      nf_ptr = 15           !: frequency of ptr computation
43   REAL(wp), PUBLIC, DIMENSION(jpj) ::   &   ! poleward transport
44      pht_adv, pst_adv,  &  !: heat and salt: advection
45      pht_ove, pst_ove,  &  !: heat and salt: overturning
46      pht_ldf, pst_ldf,  &  !: heat and salt: lateral diffusion
47      pht_eiv, pst_eiv      !: heat and salt: bolus advection
48
49   !! Module variables
50   REAL(wp), DIMENSION(jpj,jpk) ::   & 
51      tn_jk  , sn_jk  ,  &  ! "zonal" mean temperature and salinity
52      v_msf           ,  &  ! "meridional" Stream-Function
53#if defined key_diaeiv
54      v_msf_eiv       ,  &  ! bolus "meridional" Stream-Function
55#endif
56      surf_jk_r             ! inverse of the ocean "zonal" section surface
57
58   !! * Substitutions
59#  include "domzgr_substitute.h90"
60#  include "vectopt_loop_substitute.h90"
61   !!----------------------------------------------------------------------
62   !!   OPA 9.0 , LODYC-IPSL  (2003)
63   !!----------------------------------------------------------------------
64
65CONTAINS
66
67   FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval )
68      !!----------------------------------------------------------------------
69      !!                    ***  ROUTINE ptr_vj_3d  ***
70      !!
71      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
72      !!      flux array
73      !!
74      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
75      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
76      !!
77      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
78      !!
79      !! History :
80      !!   9.0  !  03-09  (G. Madec)  Original code
81      !!----------------------------------------------------------------------
82      !! * arguments
83      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
84         pva                         ! mask flux array at V-point
85
86      !! * local declarations
87      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
88      INTEGER  ::   ijpj = jpj        ! ???
89      REAL(wp),DIMENSION(jpj) ::   &
90         p_fval                       ! function value
91      !!--------------------------------------------------------------------
92
93      p_fval(:) = 0.e0
94      DO jk = 1, jpkm1
95         DO jj = 2, jpjm1
96            DO ji = fs_2, fs_jpim1   ! Vector opt.
97               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
98            END DO
99         END DO
100      END DO
101
102      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume
103
104   END FUNCTION ptr_vj_3d
105
106
107
108   FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
109      !!----------------------------------------------------------------------
110      !!                    ***  ROUTINE ptr_vj_2d  ***
111      !!
112      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
113      !!      flux array
114      !!
115      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
116      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
117      !!
118      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
119      !!
120      !! History :
121      !!   9.0  !  03-09  (G. Madec)  Original code
122      !!----------------------------------------------------------------------
123      !! * arguments
124      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   &
125         pva                         ! mask flux array at V-point
126
127      !! * local declarations
128      INTEGER  ::   ji,jj             ! dummy loop arguments
129      INTEGER  ::   ijpj = jpj        ! ???
130      REAL(wp),DIMENSION(jpj) ::   &
131         p_fval                       ! function value
132      !!--------------------------------------------------------------------
133 
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
147   FUNCTION ptr_vjk( pva )   RESULT ( p_fval )
148      !!----------------------------------------------------------------------
149      !!                    ***  ROUTINE ptr_vjk  ***
150      !!
151      !! ** Purpose :   "zonal" sum computation of a "meridional" flux array
152      !!
153      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
154      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
155      !!
156      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
157      !!
158      !! History :
159      !!   9.0  !  03-09  (G. Madec)  Original code
160      !!----------------------------------------------------------------------
161      !! * arguments
162      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
163         pva                         ! mask flux array at V-point
164
165      !! * local declarations
166      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
167      REAL(wp),DIMENSION(jpj,jpk) ::   &
168         p_fval                       ! return function value
169      !!--------------------------------------------------------------------
170 
171      p_fval(:,:) = 0.e0
172      DO jk = 1, jpkm1
173         DO jj = 2, jpjm1
174            DO ji = fs_2, fs_jpim1   ! Vector opt.
175               p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj)
176            END DO
177         END DO
178      END DO
179      IF( lk_mpp)   CALL mpp_sum( p_fval, jpj*jpk )    !!bug  I presume
180
181   END FUNCTION ptr_vjk
182
183   FUNCTION ptr_vtjk( pva )   RESULT ( p_fval )
184      !!----------------------------------------------------------------------
185      !!                    ***  ROUTINE ptr_vtjk  ***
186      !!
187      !! ** Purpose :   "zonal" mean computation of a tracer field
188      !!
189      !! ** Method  : - i-sum of mj(pva) using the interior 2D vmask (vmask_i)
190      !!      multiplied by the inverse of the surface of the "zonal" ocean
191      !!      section
192      !!
193      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
194      !!
195      !! History :
196      !!   9.0  !  03-09  (G. Madec)  Original code
197      !!----------------------------------------------------------------------
198      !! * arguments
199      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
200         pva                         ! mask flux array at V-point
201 
202      !! * local declarations
203      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
204      REAL(wp),DIMENSION(jpj,jpk) ::   &
205         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 )   CALL mpp_sum( p_fval, jpj*jpk )         !!bug  I presume
220
221   END FUNCTION ptr_vtjk
222
223
224   SUBROUTINE dia_ptr( kt )
225      !!----------------------------------------------------------------------
226      !!                  ***  ROUTINE dia_ptr  ***
227      !!----------------------------------------------------------------------
228      !! * Argument
229      INTEGER, INTENT(in) ::   kt   ! ocean time step index
230
231      !! * Local variables
232      INTEGER ::   jk               ! dummy loop
233      REAL(wp) ::    &
234         zsverdrup,  &              ! conversion from m3/s to Sverdrup
235         zpwatt,     &              ! conversion from W    to PW
236         zggram                     ! conversion from g    to Pg
237      !!----------------------------------------------------------------------
238      zsverdrup = 1.e-6
239      zpwatt    = 1.e-15
240      zggram    = 1.e-6
241
242      ! "zonal" mean temperature and salinity at V-points
243      tn_jk(:,:) = ptr_vtjk( tn(:,:,:) ) * surf_jk_r(:,:)
244      sn_jk(:,:) = ptr_vtjk( sn(:,:,:) ) * surf_jk_r(:,:)
245
246      ! "zonal" mean mass flux at V-points
247      v_msf(:,:) = ptr_vjk( vn(:,:,:) ) 
248#if defined key_diaeiv
249      ! "zonal" mean bolus mass flux at V-points
250      v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) ) 
251      ! Bolus "Meridional" Stream-Function
252      DO jk = jpkm1, 1
253         v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk)
254      END DO
255      v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup
256#endif
257
258      ! poleward transport: overturning component
259      pht_ove(:) = SUM( v_msf(:,:) * tn_jk(:,:), 2 )   ! SUM over jk
260      pst_ove(:) = SUM( v_msf(:,:) * sn_jk(:,:), 2 )   ! SUM over jk
261
262      ! conversion in PW and G g
263      zpwatt = zpwatt * rau0 * rcp
264      pht_adv(:) = pht_adv(:) * zpwatt
265      pht_ove(:) = pht_ove(:) * zpwatt
266      pht_ldf(:) = pht_ldf(:) * zpwatt
267      pht_eiv(:) = pht_eiv(:) * zpwatt
268      pst_adv(:) = pst_adv(:) * zggram
269      pst_ove(:) = pst_ove(:) * zggram
270      pst_ldf(:) = pst_ldf(:) * zggram
271      pst_eiv(:) = pst_eiv(:) * zggram
272
273      ! "Meridional" Stream-Function
274      DO jk = jpkm1, 1
275         v_msf(:,jk) = v_msf(:,jk-1) + v_msf(:,jk)
276      END DO
277      v_msf(:,:) = v_msf(:,:) * zsverdrup
278
279      ! output
280      CALL dia_ptr_wri( kt )
281
282   END SUBROUTINE dia_ptr
283
284
285   SUBROUTINE dia_ptr_init
286      !!----------------------------------------------------------------------
287      !!                  ***  ROUTINE dia_ptr_init  ***
288      !!                   
289      !! ** Purpose :   Initialization, namelist read
290      !!
291      !! ** Method  :   
292      !!
293      !! ** input   :   Namlist namptr
294      !!
295      !! ** Action  : 
296      !!
297      !! history :
298      !!   9.0  !  03-08  (Autor Names)  Original code
299      !!----------------------------------------------------------------------
300      !! * local declarations
301      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
302         z_1             ! temporary workspace
303
304      NAMELIST/namptr/ ln_diaptr, nf_ptr
305      !!----------------------------------------------------------------------
306
307      ! Read Namelist namptr : poleward transport parameters
308      REWIND ( numptr )
309      READ   ( numnam, namptr )
310
311
312      ! Control print
313      IF(lwp) THEN
314         WRITE(numout,*)
315         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
316         WRITE(numout,*) '~~~~~~~~~~~~'
317         WRITE(numout,*) '          Namelist namptr : set ptr parameters'
318         WRITE(numout,*) '             Switch for ptr diagnostic (T) or not (F) ln_diaptr = ', ln_diaptr
319         WRITE(numout,*) '             Frequency of computation                    nf_ptr = ', nf_ptr
320      ENDIF
321
322      ! inverse of the ocean "zonal" v-point section
323      z_1(:,:,:) = 1.e0
324      surf_jk_r(:,:) = ptr_vtjk( z_1(:,:,:) )
325      WHERE( surf_jk_r(:,:) /= 0.e0 )   surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:)
326
327   END SUBROUTINE dia_ptr_init
328
329#if defined key_fdir
330   !!---------------------------------------------------------------------
331   !!   'key_fdir'                                      direct access file
332   !!---------------------------------------------------------------------
333
334   SUBROUTINE dia_ptr_wri( kt )
335      !!---------------------------------------------------------------------
336      !!                ***  ROUTINE dia_ptr_wri  ***
337      !!
338      !! ** Purpose :   output of poleward fluxes
339      !!
340      !! ** Method  :   NetCDF file
341      !!
342      !! History :
343      !!   9.0  !  03-09  (G. Madec)  Original code 
344      !!----------------------------------------------------------------------
345      !! * Arguments
346      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
347      REAL(wp), DIMENSION(jpjglo) ::   zphi, zfoo
348      !!----------------------------------------------------------------------
349
350      IF( kt == nit000 ) THEN
351
352         ! Reference latitude
353         ! ------------------
354         !                                           ! =======================
355         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
356            !                                        ! =======================
357
358            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
359            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
360            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
361            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
362 
363            zphi(:) = 0.e0   
364            DO ji = mi0(iline), mi1(iline)
365               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
366            END DO
367            ! provide the correct zphi to all local domains
368            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )       
369            ! introduce arbitray northernmost grid point to avoid netcdf error
370            zphi(jpjglo) = 2*zphi(jpjglo-1)-zphi(jpjglo-2)
371
372            !                                        ! =======================
373         ELSE                                        !   OTHER configurations
374            !                                        ! =======================
375            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
376            !
377         ENDIF
378 
379         ! open the output file         
380         CALL ctlopn( numptr, 'opaptr.output', 'UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
381
382         ! header of output
383         WRITE( numptr ) cexper, no, zdt, nf_ptr, jpj, jpk, zphi
384
385      ENDIF
386
387      IF( MOD( kt, nf_ptr ) == 0 ) THEN
388            IF(lwp) WRITE( numptr ) kt, tn_jk, sn_jk, v_msf,              &
389# if defined key_diaeiv
390               &                    pht_eiv, pst_eiv, v_msf_eiv,          &
391# endif
392               &                    pht_adv, pht_ldf, pst_adv, pst_ldf
393      ENDIF
394
395      IF( kt == nitend )   CLOSE( numptr )
396
397   END SUBROUTINE dia_ptr_wri
398
399#else
400   !!---------------------------------------------------------------------
401   !!   Default option :                                       NetCDF file
402   !!---------------------------------------------------------------------
403
404   SUBROUTINE dia_ptr_wri( kt )
405      !!---------------------------------------------------------------------
406      !!                ***  ROUTINE dia_ptr_wri  ***
407      !!
408      !! ** Purpose :   output of poleward fluxes
409      !!
410      !! ** Method  :   NetCDF file
411      !!
412      !! History :
413      !!   9.0  !  03-09  (G. Madec)  Original code
414      !!----------------------------------------------------------------------
415      USE ioipsl          ! NetCDF IPSL library
416      USE daymod
417
418      !! * Arguments
419      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
420
421      !! * Save variables   
422      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw   &
423          , ndex(1)
424
425      !! * Local variables
426      CHARACTER (len=40) ::   &
427         clhstnam, clop             ! temporary names
428      INTEGER ::   iline, it, ji    !
429      REAL(wp) ::   &
430         zsto, zout, zdt, zmax, &   ! temporary scalars
431         zjulian
432      REAL(wp), DIMENSION(jpjglo) ::   zphi, zfoo
433      !!----------------------------------------------------------------------
434     
435      ! Define frequency of output and means
436      zdt = rdt
437      IF( nacc == 1 ) zdt = rdtmin
438#if defined key_diainstant
439         zsto = nf_ptr * zdt
440         clop = "inst(x)"               ! no use of the mask value (require less cpu time)
441         !!! clop="inst(only(x))"       ! put 1.e+20 on land (very expensive!!)
442#else
443         zsto = zdt
444         clop = "ave(x)"                ! no use of the mask value (require less cpu time)
445         !!! clop="ave(only(x))"        ! put 1.e+20 on land (very expensive!!)
446#endif
447      zout = nf_ptr * zdt
448      zmax = ( nitend - nit000 + 1 ) * zdt
449     
450         
451      ! define time axis
452      it = kt - nit000 + 1
453
454      ! Initialization
455      ! --------------
456      IF( kt == nit000 ) THEN
457     
458      zdt = rdt
459      IF( nacc == 1 ) zdt = rdtmin
460
461         ! Reference latitude
462         ! ------------------
463         !                                           ! =======================
464         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
465            !                                        ! =======================
466
467            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
468            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
469            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
470            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
471            zphi(:) = 0.e0
472            DO ji = mi0(iline), mi1(iline) 
473               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
474            END DO
475            ! provide the correct zphi to all local domains
476            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )       
477
478            !                                        ! =======================
479         ELSE                                        !   OTHER configurations
480            !                                        ! =======================
481            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
482            !
483         ENDIF
484
485         ! OPEN netcdf file
486         ! ----------------
487         ! Define frequency of output and means
488         zsto = nf_ptr * zdt
489         clop = "ave(x)"
490         zout = nf_ptr * zdt
491         zfoo(:) = 0.e0
492
493         ! Compute julian date from starting date of the run
494
495         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
496
497         CALL dia_nam( clhstnam, nwrite, 'diaptr' )
498         IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam
499
500         ! Horizontal grid : zphi()
501         CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
502            1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr )
503         ! Vertical grids : gdept, gdepw
504         CALL histvert( numptr, "deptht", "Vertical T levels",   &
505            "m", jpk, gdept, ndepidzt )
506         CALL histvert( numptr, "depthw", "Vertical W levels",   &
507            "m", jpk, gdepw, ndepidzw )
508         
509         !  Zonal mean T and S
510         
511         CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
512            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
513         CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
514            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
515
516         !  Meridional Stream-Function (eulerian and bolus)
517         
518         CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: global","Sv" ,   &
519            1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
520
521         !  Heat transport
522
523         CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
524            "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
525         CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
526            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
527         CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
528            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
529
530         !  Salt transport
531
532         CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
533            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
534         CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
535            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
536         CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
537            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
538
539#if defined key_diaeiv
540         ! Eddy induced velocity
541         CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   &
542            "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
543         CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
544            "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
545         CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
546            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
547#endif
548
549         CALL histend( numptr )
550
551      ENDIF
552
553      IF( MOD( kt, nf_ptr ) == 0 ) THEN
554
555         ! define time axis
556         it= kt - nit000 + 1
557         ndex(1) = 1
558         WRITE(numout,*)'kt=',kt
559         CALL histwrite( numptr, "zotemglo", it, tn_jk    , jpj*jpk, ndex )
560         WRITE(numout,*)'zotemglo OK'
561         CALL histwrite( numptr, "zosalglo", it, sn_jk    , jpj*jpk, ndex )
562         WRITE(numout,*)'zosalglo OK'
563         CALL histwrite( numptr, "zomsfglo", it, v_msf    , jpj*jpk, ndex )
564         WRITE(numout,*)'zomsfglo OK'
565         WRITE(numout,*)'MAX(pht_adv)=', MAXVAL(pht_adv)
566         WRITE(numout,*)'MIN(pht_adv)=', MINVAL(pht_adv)
567         CALL histwrite( numptr, "sophtadv", it, pht_adv  , jpj    , ndex )
568         WRITE(numout,*)'sophtadv OK'
569         WRITE(numout,*)'MAX(pht_ldf)=', MAXVAL(pht_ldf)
570         WRITE(numout,*)'MIN(pht_ldf)=', MINVAL(pht_ldf)
571         CALL histwrite( numptr, "sophtldf", it, pht_ldf  , jpj    , ndex )
572         WRITE(numout,*)'sophtldf OK'
573         WRITE(numout,*)'MAX(pht_ove)=', MAXVAL(pht_ove)
574         WRITE(numout,*)'MIN(pht_ove)=', MINVAL(pht_ove)
575         CALL histwrite( numptr, "sophtove", it, pht_ove  , jpj    , ndex )
576         WRITE(numout,*)'sophtove OK'
577         WRITE(numout,*)'MAX(pst_adv)=', MAXVAL(pst_adv)
578         WRITE(numout,*)'MIN(pst_adv)=', MINVAL(pst_adv)
579         CALL histwrite( numptr, "sopstadv", it, pst_adv  , jpj    , ndex )
580         WRITE(numout,*)'sopstadv OK'
581         WRITE(numout,*)'MAX(pst_ldf)=', MAXVAL(pst_ldf)
582         WRITE(numout,*)'MIN(pst_ldf)=', MINVAL(pst_ldf)
583         CALL histwrite( numptr, "sopstldf", it, pst_ldf  , jpj    , ndex )
584         WRITE(numout,*)'sopstldf OK'
585         WRITE(numout,*)'MAX(pst_ove)=', MAXVAL(pst_ove)
586         WRITE(numout,*)'MIN(pst_ove)=', MINVAL(pst_ove)
587         CALL histwrite( numptr, "sopstove", it, pst_ove  , jpj    , ndex )
588         WRITE(numout,*)'sopstove OK'
589#if defined key_diaeiv
590         CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex )
591         CALL histwrite( numptr, "sophteiv", it, pht_eiv  , jpj    , ndex )
592         CALL histwrite( numptr, "sopsteiv", it, pst_eiv  , jpj    , ndex )
593#endif
594 
595      ENDIF
596
597      ! Close the file
598      IF( kt == nitend )   CALL histclo( numptr )           ! Netcdf write
599
600   END SUBROUTINE dia_ptr_wri
601
602#endif
603
604   !!======================================================================
605END MODULE diaptr
Note: See TracBrowser for help on using the repository browser.