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

Last change on this file since 190 was 190, checked in by opalod, 19 years ago

CT : BUGFIX131 : suppress the use of ln_diaptr in opa.F90 and set the default value of ln_diaptr to FALSE in diaptr.F90
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.6 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      INTEGER, DIMENSION (1) :: ish
168      INTEGER, DIMENSION (2) :: ish2
169      REAL(wp),DIMENSION(jpj*jpk) ::   &
170         zwork                        ! temporary vector for mpp_sum
171      REAL(wp),DIMENSION(jpj,jpk) ::   &
172         p_fval                       ! return function value
173      !!--------------------------------------------------------------------
174 
175      p_fval(:,:) = 0.e0
176      DO jk = 1, jpkm1
177         DO jj = 2, jpjm1
178            DO ji = fs_2, fs_jpim1   ! Vector opt.
179               p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj)
180            END DO
181         END DO
182      END DO
183      IF( lk_mpp)   THEN
184          ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk
185          zwork(:)= RESHAPE(p_fval, ish )
186          CALL mpp_sum(zwork, jpj*jpk )
187          p_fval(:,:)= RESHAPE(zwork,ish2)
188      END IF
189
190   END FUNCTION ptr_vjk
191
192   FUNCTION ptr_vtjk( pva )   RESULT ( p_fval )
193      !!----------------------------------------------------------------------
194      !!                    ***  ROUTINE ptr_vtjk  ***
195      !!
196      !! ** Purpose :   "zonal" mean computation of a tracer field
197      !!
198      !! ** Method  : - i-sum of mj(pva) using the interior 2D vmask (vmask_i)
199      !!      multiplied by the inverse of the surface of the "zonal" ocean
200      !!      section
201      !!
202      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
203      !!
204      !! History :
205      !!   9.0  !  03-09  (G. Madec)  Original code
206      !!----------------------------------------------------------------------
207      !! * arguments
208      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
209         pva                         ! mask flux array at V-point
210 
211      !! * local declarations
212      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
213      INTEGER, DIMENSION (1) :: ish
214      INTEGER, DIMENSION (2) :: ish2
215      REAL(wp),DIMENSION(jpj*jpk) ::   &
216         zwork                        ! temporary vector for mpp_sum
217      REAL(wp),DIMENSION(jpj,jpk) ::   &
218         p_fval                       ! return function value
219      !!--------------------------------------------------------------------
220
221      p_fval(:,:) = 0.e0
222      DO jk = 1, jpkm1
223         DO jj = 2, jpjm1
224            DO ji = fs_2, fs_jpim1   ! Vector opt.
225               p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj+1,jk) )              &
226                  &                          * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)   &
227                  &                          * tmask_i(ji,jj+1) * tmask_i(ji,jj)
228            END DO
229         END DO
230      END DO
231      p_fval(:,:) = p_fval(:,:) * 0.5
232      IF( lk_mpp)   THEN
233          ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk
234          zwork(:)= RESHAPE(p_fval, ish )
235          CALL mpp_sum(zwork, jpj*jpk )
236          p_fval(:,:)= RESHAPE(zwork,ish2)
237      END IF
238
239   END FUNCTION ptr_vtjk
240
241
242   SUBROUTINE dia_ptr( kt )
243      !!----------------------------------------------------------------------
244      !!                  ***  ROUTINE dia_ptr  ***
245      !!----------------------------------------------------------------------
246      !! * Argument
247      INTEGER, INTENT(in) ::   kt   ! ocean time step index
248
249      !! * Local variables
250      INTEGER ::   jk               ! dummy loop
251      REAL(wp) ::    &
252         zsverdrup,  &              ! conversion from m3/s to Sverdrup
253         zpwatt,     &              ! conversion from W    to PW
254         zggram                     ! conversion from g    to Pg
255      !!----------------------------------------------------------------------
256      zsverdrup = 1.e-6
257      zpwatt    = 1.e-15
258      zggram    = 1.e-6
259
260      ! "zonal" mean temperature and salinity at V-points
261      tn_jk(:,:) = ptr_vtjk( tn(:,:,:) ) * surf_jk_r(:,:)
262      sn_jk(:,:) = ptr_vtjk( sn(:,:,:) ) * surf_jk_r(:,:)
263
264      ! "zonal" mean mass flux at V-points
265      v_msf(:,:) = ptr_vjk( vn(:,:,:) ) 
266#if defined key_diaeiv
267      ! "zonal" mean bolus mass flux at V-points
268      v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) ) 
269      ! Bolus "Meridional" Stream-Function
270      DO jk = jpkm1, 1 , -1
271         v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk)
272      END DO
273      v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup
274#endif
275
276      ! poleward transport: overturning component
277      pht_ove(:) = SUM( v_msf(:,:) * tn_jk(:,:), 2 )   ! SUM over jk
278      pst_ove(:) = SUM( v_msf(:,:) * sn_jk(:,:), 2 )   ! SUM over jk
279
280      ! conversion in PW and G g
281      zpwatt = zpwatt * rau0 * rcp
282      pht_adv(:) = pht_adv(:) * zpwatt
283      pht_ove(:) = pht_ove(:) * zpwatt
284      pht_ldf(:) = pht_ldf(:) * zpwatt
285      pht_eiv(:) = pht_eiv(:) * zpwatt
286      pst_adv(:) = pst_adv(:) * zggram
287      pst_ove(:) = pst_ove(:) * zggram
288      pst_ldf(:) = pst_ldf(:) * zggram
289      pst_eiv(:) = pst_eiv(:) * zggram
290
291      ! "Meridional" Stream-Function
292      DO jk = jpkm1, 1, -1
293         v_msf(:,jk) = v_msf(:,jk-1) + v_msf(:,jk)
294      END DO
295      v_msf(:,:) = v_msf(:,:) * zsverdrup
296
297      ! output
298      CALL dia_ptr_wri( kt )
299
300   END SUBROUTINE dia_ptr
301
302
303   SUBROUTINE dia_ptr_init
304      !!----------------------------------------------------------------------
305      !!                  ***  ROUTINE dia_ptr_init  ***
306      !!                   
307      !! ** Purpose :   Initialization, namelist read
308      !!
309      !! ** Method  :   
310      !!
311      !! ** input   :   Namlist namptr
312      !!
313      !! ** Action  : 
314      !!
315      !! history :
316      !!   9.0  !  03-08  (Autor Names)  Original code
317      !!----------------------------------------------------------------------
318      !! * local declarations
319      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
320         z_1             ! temporary workspace
321
322      NAMELIST/namptr/ ln_diaptr, nf_ptr
323      !!----------------------------------------------------------------------
324
325      ! Read Namelist namptr : poleward transport parameters
326      REWIND ( numptr )
327      READ   ( numnam, namptr )
328
329
330      ! Control print
331      IF(lwp) THEN
332         WRITE(numout,*)
333         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
334         WRITE(numout,*) '~~~~~~~~~~~~'
335         WRITE(numout,*) '          Namelist namptr : set ptr parameters'
336         WRITE(numout,*) '             Switch for ptr diagnostic (T) or not (F) ln_diaptr = ', ln_diaptr
337         WRITE(numout,*) '             Frequency of computation                    nf_ptr = ', nf_ptr
338      ENDIF
339
340      ! inverse of the ocean "zonal" v-point section
341      z_1(:,:,:) = 1.e0
342      surf_jk_r(:,:) = ptr_vtjk( z_1(:,:,:) )
343      WHERE( surf_jk_r(:,:) /= 0.e0 )   surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:)
344
345   END SUBROUTINE dia_ptr_init
346
347#if defined key_fdir
348   !!---------------------------------------------------------------------
349   !!   'key_fdir'                                      direct access file
350   !!---------------------------------------------------------------------
351
352   SUBROUTINE dia_ptr_wri( kt )
353      !!---------------------------------------------------------------------
354      !!                ***  ROUTINE dia_ptr_wri  ***
355      !!
356      !! ** Purpose :   output of poleward fluxes
357      !!
358      !! ** Method  :   NetCDF file
359      !!
360      !! History :
361      !!   9.0  !  03-09  (G. Madec)  Original code 
362      !!----------------------------------------------------------------------
363      !! * Arguments
364      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
365      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo
366      !!----------------------------------------------------------------------
367
368      IF( kt == nit000 ) THEN
369
370         ! Reference latitude
371         ! ------------------
372         !                                           ! =======================
373         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
374            !                                        ! =======================
375
376            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
377            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
378            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
379            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
380 
381            zphi(:) = 0.e0   
382            DO ji = mi0(iline), mi1(iline)
383               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
384            END DO
385            ! provide the correct zphi to all local domains
386            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )       
387            ! introduce arbitray northernmost grid point to avoid netcdf error
388            DO jj=mj0(jpjglo), mj1(jpjglo)
389               zphi(jj) = 2*zphi(jj-1)-zphi(jj-2)
390            ENDDO
391
392            !                                        ! =======================
393         ELSE                                        !   OTHER configurations
394            !                                        ! =======================
395            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
396            !
397         ENDIF
398 
399         ! open the output file         
400         CALL ctlopn( numptr, 'opaptr.output', 'UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
401
402         ! header of output
403         WRITE( numptr ) cexper, no, zdt, nf_ptr, jpj, jpk, zphi
404
405      ENDIF
406
407      IF( MOD( kt, nf_ptr ) == 0 ) THEN
408            IF(lwp) WRITE( numptr ) kt, tn_jk, sn_jk, v_msf,              &
409# if defined key_diaeiv
410               &                    pht_eiv, pst_eiv, v_msf_eiv,          &
411# endif
412               &                    pht_adv, pht_ldf, pst_adv, pst_ldf
413      ENDIF
414
415      IF( kt == nitend )   CLOSE( numptr )
416
417   END SUBROUTINE dia_ptr_wri
418
419#else
420   !!---------------------------------------------------------------------
421   !!   Default option :                                       NetCDF file
422   !!---------------------------------------------------------------------
423
424   SUBROUTINE dia_ptr_wri( kt )
425      !!---------------------------------------------------------------------
426      !!                ***  ROUTINE dia_ptr_wri  ***
427      !!
428      !! ** Purpose :   output of poleward fluxes
429      !!
430      !! ** Method  :   NetCDF file
431      !!
432      !! History :
433      !!   9.0  !  03-09  (G. Madec)  Original code
434      !!----------------------------------------------------------------------
435      USE ioipsl          ! NetCDF IPSL library
436      USE daymod
437
438      !! * Arguments
439      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
440
441      !! * Save variables   
442      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw   &
443          , ndex(1)
444
445      !! * Local variables
446      CHARACTER (len=40) ::   &
447         clhstnam, clop             ! temporary names
448      INTEGER ::   iline, it, ji    !
449      REAL(wp) ::   &
450         zsto, zout, zdt, zmax, &   ! temporary scalars
451         zjulian
452      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo
453      !!----------------------------------------------------------------------
454     
455      ! Define frequency of output and means
456      zdt = rdt
457      IF( nacc == 1 ) zdt = rdtmin
458#if defined key_diainstant
459         zsto = nf_ptr * zdt
460         clop = "inst(x)"               ! no use of the mask value (require less cpu time)
461         !!! clop="inst(only(x))"       ! put 1.e+20 on land (very expensive!!)
462#else
463         zsto = zdt
464         clop = "ave(x)"                ! no use of the mask value (require less cpu time)
465         !!! clop="ave(only(x))"        ! put 1.e+20 on land (very expensive!!)
466#endif
467      zout = nf_ptr * zdt
468      zmax = ( nitend - nit000 + 1 ) * zdt
469     
470         
471      ! define time axis
472      it = kt - nit000 + 1
473
474      ! Initialization
475      ! --------------
476      IF( kt == nit000 ) THEN
477     
478      zdt = rdt
479      IF( nacc == 1 ) zdt = rdtmin
480
481         ! Reference latitude
482         ! ------------------
483         !                                           ! =======================
484         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
485            !                                        ! =======================
486
487            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
488            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
489            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
490            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
491            zphi(:) = 0.e0
492            DO ji = mi0(iline), mi1(iline) 
493               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
494            END DO
495            ! provide the correct zphi to all local domains
496            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )       
497
498            !                                        ! =======================
499         ELSE                                        !   OTHER configurations
500            !                                        ! =======================
501            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
502            !
503         ENDIF
504
505         ! OPEN netcdf file
506         ! ----------------
507         ! Define frequency of output and means
508         zsto = nf_ptr * zdt
509         clop = "ave(x)"
510         zout = nf_ptr * zdt
511         zfoo(:) = 0.e0
512
513         ! Compute julian date from starting date of the run
514
515         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
516
517         CALL dia_nam( clhstnam, nwrite, 'diaptr' )
518         IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam
519
520         ! Horizontal grid : zphi()
521         CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
522            1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr )
523         ! Vertical grids : gdept, gdepw
524         CALL histvert( numptr, "deptht", "Vertical T levels",   &
525            "m", jpk, gdept, ndepidzt )
526         CALL histvert( numptr, "depthw", "Vertical W levels",   &
527            "m", jpk, gdepw, ndepidzw )
528         
529         !  Zonal mean T and S
530         
531         CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
532            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
533         CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
534            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
535
536         !  Meridional Stream-Function (eulerian and bolus)
537         
538         CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: global","Sv" ,   &
539            1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
540
541         !  Heat transport
542
543         CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
544            "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
545         CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
546            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
547         CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
548            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
549
550         !  Salt transport
551
552         CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
553            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
554         CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
555            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
556         CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
557            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
558
559#if defined key_diaeiv
560         ! Eddy induced velocity
561         CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   &
562            "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
563         CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
564            "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
565         CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
566            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
567#endif
568
569         CALL histend( numptr )
570
571      ENDIF
572
573      IF( MOD( kt, nf_ptr ) == 0 ) THEN
574
575         ! define time axis
576         it= kt - nit000 + 1
577         ndex(1) = 1
578         CALL histwrite( numptr, "zotemglo", it, tn_jk    , jpj*jpk, ndex )
579         CALL histwrite( numptr, "zosalglo", it, sn_jk    , jpj*jpk, ndex )
580         CALL histwrite( numptr, "zomsfglo", it, v_msf    , jpj*jpk, ndex )
581         CALL histwrite( numptr, "sophtadv", it, pht_adv  , jpj    , ndex )
582         CALL histwrite( numptr, "sophtldf", it, pht_ldf  , jpj    , ndex )
583         CALL histwrite( numptr, "sophtove", it, pht_ove  , jpj    , ndex )
584         CALL histwrite( numptr, "sopstadv", it, pst_adv  , jpj    , ndex )
585         CALL histwrite( numptr, "sopstldf", it, pst_ldf  , jpj    , ndex )
586         CALL histwrite( numptr, "sopstove", it, pst_ove  , jpj    , ndex )
587#if defined key_diaeiv
588         CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex )
589         CALL histwrite( numptr, "sophteiv", it, pht_eiv  , jpj    , ndex )
590         CALL histwrite( numptr, "sopsteiv", it, pst_eiv  , jpj    , ndex )
591#endif
592 
593      ENDIF
594
595      ! Close the file
596      IF( kt == nitend )   CALL histclo( numptr )           ! Netcdf write
597
598   END SUBROUTINE dia_ptr_wri
599
600#endif
601
602   !!======================================================================
603END MODULE diaptr
Note: See TracBrowser for help on using the repository browser.