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.
ptr.F90 in tags/nemo_dev_x2/NEMO/OPA_SRC/DIA – NEMO

source: tags/nemo_dev_x2/NEMO/OPA_SRC/DIA/ptr.F90 @ 4310

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

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