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

Last change on this file since 1559 was 1559, checked in by ctlod, 15 years ago

only cosmetic changes
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 47.2 KB
Line 
1MODULE diaptr
2   !!======================================================================
3   !!                       ***  MODULE  diaptr  ***
4   !! Ocean physics:  Computes meridonal transports and zonal means
5   !!=====================================================================
6   !! History :  1.0  ! 2003-09  (C. Talandier, G. Madec)  Original code
7   !!            2.0  ! 2006-01  (A. Biastoch)  Allow sub-basins computation
8   !!            3.2  ! 2003-03  (O. Marti, S. Flavoni) Add fields
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dia_ptr      : Poleward Transport Diagnostics module
13   !!   dia_ptr_init : Initialization, namelist read
14   !!   dia_ptr_wri  : Output of poleward fluxes
15   !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array
16   !!   ptr_tjk      : "zonal" mean computation of a tracer field
17   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional"
18   !!                : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d
19   !!----------------------------------------------------------------------
20   USE oce           ! ocean dynamics and active tracers
21   USE dom_oce       ! ocean space and time domain
22   USE daymod        ! calandar
23   USE phycst        ! physical constants
24   USE ldftra_oce    ! ocean active tracers: lateral physics
25   USE dianam
26   USE iom
27   USE ioipsl         
28   USE in_out_manager
29   USE lib_mpp
30
31   IMPLICIT NONE
32   PRIVATE
33
34   INTERFACE ptr_vj
35      MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
36   END INTERFACE
37
38   PUBLIC   dia_ptr_init   ! call in opa module
39   PUBLIC   dia_ptr        ! call in step module
40   PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines
41   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines
42
43   !                                           !!** namelist  namptr  **
44   LOGICAL , PUBLIC ::   ln_diaptr  = .FALSE.   !: Poleward transport flag (T) or not (F)
45   LOGICAL , PUBLIC ::   ln_subbas  = .FALSE.   !: Atlantic/Pacific/Indian basins calculation
46   LOGICAL , PUBLIC ::   ln_diaznl  = .FALSE.   !: Add zonal means and meridional stream functions
47   LOGICAL , PUBLIC ::   ln_ptrcomp = .FALSE.   !: Add decomposition : overturning (and gyre, soon ...)
48   INTEGER , PUBLIC ::   nf_ptr     = 15        !: frequency of ptr computation
49   INTEGER , PUBLIC ::   nf_ptr_wri = 15        !: frequency of ptr outputs
50
51   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin, dbasin, sbasin   !: Sub basin masks
52
53   !                                                               !!! poleward heat and salt transport
54   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv    , pst_adv       !: advection
55   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ldf    , pst_ldf       !: lateral diffusion
56   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_glo, pst_ove_glo   !: global       overturning
57   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_atl, pst_ove_atl   !: Atlantic     overturning
58   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_pac, pst_ove_pac   !: Pacific      overturning
59   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ind, pst_ove_ind   !: Indian       overturning
60   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ipc, pst_ove_ipc   !: Indo-Pacific overturning
61   REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_glo, ht_atl, ht_ind, ht_pac, ht_ipc   !: heat
62   REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_glo, st_atl, st_ind, st_pac, st_ipc   !: salt
63
64   INTEGER ::   niter
65   INTEGER ::   nidom_ptr
66
67   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_glo  , sn_jk_glo       ! global       i-mean temperature and salinity
68   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_atl  , sn_jk_atl       ! Atlantic               -              -
69   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_pac  , sn_jk_pac       ! Pacific                -              -
70   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ind  , sn_jk_ind       ! Indian                 -              -
71   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ipc  , sn_jk_ipc       ! Indo-Pacific           -              -
72   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_glo                    ! global       "meridional" Stream-Function
73   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_atl                    ! Atlantic               -              -
74   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_pac                    ! Pacific                -              -
75   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ind                    ! Indian                 -              -
76   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ipc                    ! Indo-Pacific           -              -
77   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_glo, surf_jk_r_glo   ! surface of global       i-section and its inverse
78   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_atl, surf_jk_r_atl   ! surface of Atlantic          -              -
79   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_pac, surf_jk_r_pac   ! surface of Pacific           -              -
80   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ind, surf_jk_r_ind   ! surface of Indian            -              -
81   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ipc, surf_jk_r_ipc   ! surface of Indo-Pacific      -              -
82#if defined key_diaeiv
83   !                                                               !!! eddy induced velocity (bolus)
84   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_glo, pst_eiv_glo   !: global       poleward heat and salt bolus advection
85   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_atl, pst_eiv_atl   !: Atlantic         -                           -
86   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_pac, pst_eiv_pac   !: Pacific          -                           -
87   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ind, pst_eiv_ind   !: Indian           -                           -
88   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ipc, pst_eiv_ipc   !: Indo-Pacific     -                           -
89
90   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_glo   ! global       "meridional" bolus Stream-Function
91   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_atl   ! Atlantic          -                   -
92   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_pac   ! Pacific           -                   -
93   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ind   ! Indian            -                   -
94   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ipc   ! Indo-Pacific      -                   -
95#endif
96 
97   !! * Substitutions
98#  include "domzgr_substitute.h90"
99#  include "vectopt_loop_substitute.h90"
100   !!----------------------------------------------------------------------
101   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
102   !! $Id$
103   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
104   !!----------------------------------------------------------------------
105
106CONTAINS
107
108   FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval )
109      !!----------------------------------------------------------------------
110      !!                    ***  ROUTINE ptr_vj_3d  ***
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      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
121      !!
122      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
123      INTEGER                  ::   ijpj         ! ???
124      REAL(wp), DIMENSION(jpj) ::   p_fval       ! function value
125      !!--------------------------------------------------------------------
126      !
127      ijpj = jpj
128      p_fval(:) = 0.e0
129      DO jk = 1, jpkm1
130         DO jj = 2, jpjm1
131            DO ji = fs_2, fs_jpim1   ! Vector opt.
132               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
133            END DO
134         END DO
135      END DO
136      !
137#if defined key_mpp_mpi
138      CALL mpp_sum( p_fval, ijpj, ncomm_znl)     !!bug  I presume
139#endif
140      !
141   END FUNCTION ptr_vj_3d
142
143
144   FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
145      !!----------------------------------------------------------------------
146      !!                    ***  ROUTINE ptr_vj_2d  ***
147      !!
148      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
149      !!      flux array
150      !!
151      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
152      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
153      !!
154      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
155      !!----------------------------------------------------------------------
156      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point
157      !!
158      INTEGER                  ::   ji,jj    ! dummy loop arguments
159      INTEGER                  ::   ijpj     ! ???
160      REAL(wp), DIMENSION(jpj) ::   p_fval   ! function value
161      !!--------------------------------------------------------------------
162      !
163      ijpj = jpj
164      p_fval(:) = 0.e0
165      DO jj = 2, jpjm1
166         DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
167            p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
168         END DO
169      END DO
170      !
171#if defined key_mpp_mpi
172      CALL mpp_sum( p_fval, ijpj, ncomm_znl )     !!bug  I presume
173#endif
174      !
175   END FUNCTION ptr_vj_2d
176
177
178   FUNCTION ptr_vjk( pva, bmask )   RESULT ( p_fval )
179      !!----------------------------------------------------------------------
180      !!                    ***  ROUTINE ptr_vjk  ***
181      !!
182      !! ** Purpose :   "zonal" sum computation of a "meridional" flux array
183      !!
184      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
185      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
186      !!
187      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
188      !!----------------------------------------------------------------------
189      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva     ! mask flux array at V-point
190      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   bmask   ! Optional 2D basin mask
191      !!
192      INTEGER                      ::   ji, jj, jk   ! dummy loop arguments
193      REAL(wp), DIMENSION(jpj,jpk) ::   p_fval       ! return function value
194#if defined key_mpp_mpi
195      INTEGER, DIMENSION(1) ::   ish
196      INTEGER, DIMENSION(2) ::   ish2
197      REAL(wp), DIMENSION(jpj*jpk) ::   zwork   ! 1D workspace
198#endif
199      !!--------------------------------------------------------------------
200      !
201      p_fval(:,:) = 0.e0
202      !
203      IF( PRESENT( bmask ) ) THEN
204         DO jk = 1, jpkm1
205            DO jj = 2, jpjm1
206!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
207               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
208                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   &
209                     &                                          * tmask_i(ji,jj) * bmask(ji,jj)
210               END DO
211            END DO
212         END DO
213      ELSE
214         DO jk = 1, jpkm1
215            DO jj = 2, jpjm1
216               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
217                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   &
218                     &                                          * tmask_i(ji,jj)
219               END DO
220            END DO
221         END DO
222      END IF
223      !
224#if defined key_mpp_mpi
225      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk
226      zwork(:) = RESHAPE( p_fval, ish )
227      CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )
228      p_fval(:,:) = RESHAPE( zwork, ish2 )
229#endif
230      !
231   END FUNCTION ptr_vjk
232
233
234   FUNCTION ptr_tjk( pta, bmask )   RESULT ( p_fval )
235      !!----------------------------------------------------------------------
236      !!                    ***  ROUTINE ptr_tjk  ***
237      !!
238      !! ** Purpose :   "zonal" mean computation of a tracer field
239      !!
240      !! ** Method  : - i-sum of mj(pta) using tmask
241      !!      multiplied by the inverse of the surface of the "zonal" ocean
242      !!      section
243      !!
244      !! ** Action  : - p_fval: i-k-mean poleward flux of pta
245      !!----------------------------------------------------------------------
246      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
247      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask
248      !!
249      INTEGER                     ::   ji, jj, jk   ! dummy loop arguments
250      REAL(wp),DIMENSION(jpj,jpk) ::   p_fval       ! return function value
251#if defined key_mpp_mpi
252      INTEGER, DIMENSION(1) ::   ish
253      INTEGER, DIMENSION(2) ::   ish2
254      REAL(wp),DIMENSION(jpj*jpk) ::   zwork   ! 1D workspace
255#endif
256      !!--------------------------------------------------------------------
257      !
258      p_fval(:,:) = 0.e0
259      IF (PRESENT (bmask)) THEN
260         DO jk = 1, jpkm1
261            DO jj = 2, jpjm1
262               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
263                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  &
264                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   &
265                     &                          * tmask_i(ji,jj)                 &
266                     &                          * bmask(ji,jj)
267               END DO
268            END DO
269         END DO
270      ELSE
271         DO jk = 1, jpkm1
272            DO jj = 2, jpjm1
273               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
274                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  &
275                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   &
276                     &                          * tmask_i(ji,jj)
277               END DO
278            END DO
279         END DO
280      END IF
281      p_fval(:,:) = p_fval(:,:) * 0.5
282#if defined key_mpp_mpi
283      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk
284      zwork(:)= RESHAPE( p_fval, ish )
285      CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )
286      p_fval(:,:)= RESHAPE(zwork,ish2)
287#endif
288      !
289   END FUNCTION ptr_tjk
290
291
292   SUBROUTINE dia_ptr( kt )
293      !!----------------------------------------------------------------------
294      !!                  ***  ROUTINE dia_ptr  ***
295      !!----------------------------------------------------------------------
296      INTEGER, INTENT(in) ::   kt   ! ocean time step index
297      !!
298      INTEGER  ::   jk, jj, ji   ! dummy loop
299      REAL(wp) ::   zsverdrup    ! conversion from m3/s to Sverdrup
300      REAL(wp) ::   zpwatt       ! conversion from W    to PW
301      REAL(wp) ::   zggram       ! conversion from g    to Pg
302      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   vt, vs   ! 3D workspace
303      !!----------------------------------------------------------------------
304
305      IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 )   THEN
306
307         IF ( MOD( kt, nf_ptr ) == 0 ) THEN
308
309            zsverdrup = 1.e-6
310            zpwatt    = 1.e-15
311            zggram    = 1.e-6
312
313            IF ( ln_diaznl ) THEN
314               ! "zonal" mean temperature and salinity at V-points
315               tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:)
316               sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:)
317
318               IF (ln_subbas) THEN
319                  tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:)
320                  sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:)
321                  tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:)
322                  sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:)
323                  tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:)
324                  sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:)
325                  tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:)
326                  sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:)
327               ENDIF
328            ENDIF
329
330            !--------------------------------------------------------
331            ! overturning calculation:
332
333            ! horizontal integral and vertical dz
334
335#if defined key_diaeiv
336            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 
337            IF( ln_subbas .AND. ln_diaznl ) THEN
338               v_msf_atl(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 
339               v_msf_pac(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
340               v_msf_ind(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
341               v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
342            ENDIF
343#else
344            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 
345            IF( ln_subbas .AND. ln_diaznl ) THEN
346               v_msf_atl(:,:) = ptr_vjk( vn(:,:,:), abasin(:,:)*sbasin(:,:) ) 
347               v_msf_pac(:,:) = ptr_vjk( vn(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
348               v_msf_ind(:,:) = ptr_vjk( vn(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
349               v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
350            ENDIF
351#endif
352
353#if defined key_diaeiv
354            v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) )
355            IF (ln_subbas ) THEN
356               v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) )
357               v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) )
358               v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) )
359               v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) )
360            END IF
361#endif
362
363            ! "Meridional" Stream-Function
364            DO jk = 2,jpk 
365               v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk)
366            END DO
367            v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup
368#if defined key_diaeiv
369            ! Bolus "Meridional" Stream-Function
370            DO jk = 2,jpk
371               v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk)
372            END DO
373            v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup
374            IF ( ln_subbas ) THEN
375               DO jk = 2,jpk
376                  v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk)
377                  v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk)
378                  v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk)
379                  v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk)
380               END DO
381            ENDIF
382#endif
383            !
384            IF( ln_subbas .AND. ln_diaznl ) THEN
385               DO jk = 2,jpk 
386                  v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk)
387                  v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk)
388                  v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk)
389                  v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk)
390               END DO
391               v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup
392               v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup
393               v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup
394               v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup
395            ENDIF
396
397            ! Transports
398            ! T times V on T points (include bolus velocities)
399#if defined key_diaeiv 
400            DO jj = 1, jpj
401               DO ji = 1, jpi
402                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5
403                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5
404               END DO
405            END DO
406#else
407            DO jj = 1, jpj
408               DO ji = 1, jpi
409                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5
410                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:)  )*0.5
411               END DO
412            END DO
413#endif
414
415            ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 )
416            st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 )
417
418            IF ( ln_subbas ) THEN
419               ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )
420               ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )
421               ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )
422               ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )
423               st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )
424               st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )
425               st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )
426               st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )
427            ENDIF
428
429            ! poleward tracer transports:
430            ! overturning components:
431            IF ( ln_ptrcomp ) THEN
432               pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk
433               pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 ) 
434               IF ( ln_subbas ) THEN
435                  pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk
436                  pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 ) 
437                  pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk
438                  pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 ) 
439                  pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk
440                  pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 ) 
441                  pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk
442                  pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 ) 
443               END IF
444            END IF
445
446            ! Bolus component
447#if defined key_diaeiv
448            pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk
449            pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk
450            IF ( ln_subbas ) THEN
451               pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk
452               pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk
453               pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk
454               pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk
455               pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk
456               pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk
457               pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk
458               pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk
459            ENDIF
460#endif
461
462            ! conversion in PW and G g
463            zpwatt = zpwatt * rau0 * rcp
464            pht_adv(:) = pht_adv(:) * zpwatt 
465            pht_ldf(:) = pht_ldf(:) * zpwatt
466            pst_adv(:) = pst_adv(:) * zggram
467            pst_ldf(:) = pst_ldf(:) * zggram
468            IF ( ln_ptrcomp ) THEN
469               pht_ove_glo(:) = pht_ove_glo(:) * zpwatt
470               pst_ove_glo(:) = pst_ove_glo(:) * zggram
471            END IF
472#if defined key_diaeiv
473            pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt
474            pst_eiv_glo(:) = pst_eiv_glo(:) * zggram
475#endif
476            IF( ln_subbas ) THEN
477               ht_atl(:) = ht_atl(:) * zpwatt
478               ht_pac(:) = ht_pac(:) * zpwatt
479               ht_ind(:) = ht_ind(:) * zpwatt
480               ht_ipc(:) = ht_ipc(:) * zpwatt
481               st_atl(:) = st_atl(:) * zggram 
482               st_pac(:) = st_pac(:) * zggram
483               st_ind(:) = st_ind(:) * zggram
484               st_ipc(:) = st_ipc(:) * zggram
485            ENDIF
486         ENDIF
487         !
488         CALL dia_ptr_wri( kt )                        ! outputs
489         !
490      ENDIF
491      !
492      IF( kt == nitend )   CALL histclo( numptr )      ! Close the file
493      !
494   END SUBROUTINE dia_ptr
495
496
497   SUBROUTINE dia_ptr_init
498      !!----------------------------------------------------------------------
499      !!                  ***  ROUTINE dia_ptr_init  ***
500      !!                   
501      !! ** Purpose :   Initialization, namelist read
502      !!----------------------------------------------------------------------
503      INTEGER ::   inum       ! temporary logical unit
504#if defined key_mpp_mpi
505      INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
506#endif
507      !!
508      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nf_ptr, nf_ptr_wri
509      !!----------------------------------------------------------------------
510
511      REWIND ( numnam )              ! Read Namelist namptr : poleward transport parameters
512      READ   ( numnam, namptr )
513
514      IF(lwp) THEN                   ! Control print
515         WRITE(numout,*)
516         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
517         WRITE(numout,*) '~~~~~~~~~~~~'
518         WRITE(numout,*) '   Namelist namptr : set ptr parameters'
519         WRITE(numout,*) '      Switch for ptr diagnostic (T) or not (F)  ln_diaptr  = ', ln_diaptr
520         WRITE(numout,*) '      Atl/Pac/Ind basins computation            ln_subbas  = ', ln_subbas
521         WRITE(numout,*) '      Frequency of computation                  nf_ptr     = ', nf_ptr
522         WRITE(numout,*) '      Frequency of outputs                      nf_ptr_wri = ', nf_ptr_wri
523      ENDIF
524
525      IF( lk_mpp )   CALL mpp_ini_znl      ! Define MPI communicator for zonal sum
526
527      IF( ln_subbas ) THEN                 ! load sub-basin mask
528         CALL iom_open( 'subbasins', inum )
529         CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin
530         CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin
531         CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin
532         CALL iom_close( inum )
533         dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) )
534         sbasin(:,:) = tmask (:,:,1)
535         WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0
536      ENDIF
537     
538!!gm CAUTION : this is only valid in fixed volume case !
539
540      ! inverse of the ocean "zonal" v-point section
541      surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) )
542      surf_jk_r_glo(:,:) = 0.e0
543      WHERE( surf_jk_glo(:,:) /= 0.e0 )   surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:)
544     
545      IF (ln_subbas) THEN
546         surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) )
547         surf_jk_r_atl(:,:) = 0.e0
548         WHERE( surf_jk_atl(:,:) /= 0.e0 )   surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:)
549         !
550         surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) )
551         surf_jk_r_pac(:,:) = 0.e0
552         WHERE( surf_jk_pac(:,:) /= 0.e0 )   surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:)
553         !
554         surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) )
555         surf_jk_r_ind(:,:) = 0.e0
556         WHERE( surf_jk_ind(:,:) /= 0.e0 )   surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:)
557         !
558         surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) )
559         surf_jk_r_ipc(:,:) = 0.e0
560         WHERE( surf_jk_ipc(:,:) /= 0.e0 )   surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:)
561      END IF
562
563     
564      !!----------------------------------------------------------------------
565
566#if defined key_mpp_mpi 
567      iglo (1) = jpjglo
568      iloc (1) = nlcj
569      iabsf(1) = njmppt(narea)
570      iabsl(:) = iabsf(:) + iloc(:) - 1
571      ihals(1) = nldj - 1
572      ihale(1) = nlcj - nlej
573      idid (1) = 2
574
575!-$$      IF(lwp) THEN
576!-$$          WRITE(numout,*)
577!-$$          WRITE(numout,*) 'dia_ptr_init :   iloc  = ', iloc
578!-$$          WRITE(numout,*) '~~~~~~~~~~~~     iabsf = ', iabsf
579!-$$          WRITE(numout,*) '                 ihals = ', ihals
580!-$$          WRITE(numout,*) '                 ihale = ', ihale
581!-$$      ENDIF
582
583      CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr)
584#else
585      nidom_ptr = FLIO_DOM_NONE
586#endif
587      !
588   END SUBROUTINE dia_ptr_init
589
590
591   SUBROUTINE dia_ptr_wri( kt )
592      !!---------------------------------------------------------------------
593      !!                ***  ROUTINE dia_ptr_wri  ***
594      !!
595      !! ** Purpose :   output of poleward fluxes
596      !!
597      !! ** Method  :   NetCDF file
598      !!----------------------------------------------------------------------
599      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
600      !!
601      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw
602      INTEGER, SAVE :: ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc
603      INTEGER, SAVE ::         ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30
604      INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30
605      INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc
606      INTEGER, SAVE, DIMENSION (jpj*jpk) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30
607      INTEGER, SAVE, DIMENSION (jpj)     :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
608
609      CHARACTER (len=40)       ::   clhstnam, clop, clop_once, cl_comment   ! temporary names
610      INTEGER                  ::   iline, it, itmod, ji, jj, jk      !
611      REAL(wp)                 ::   zsto, zout, zdt, zjulian   ! temporary scalars
612      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo
613      REAL(wp), DIMENSION(jpj,jpk) :: z_1
614      !!----------------------------------------------------------------------
615
616      ! define time axis
617      it    = kt / nf_ptr
618      itmod = kt - nit000 + 1
619     
620!-$$      IF(lwp) THEN
621!-$$         WRITE(numout,*)
622!-$$         WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter
623!-$$         WRITE(numout,*) '~~~~~~~~~~~~'
624!-$$      ENDIF
625
626      ! Initialization
627      ! --------------
628      IF( kt == nit000 ) THEN
629
630         niter = (nit000 - 1) / nf_ptr
631
632!-$$         IF(lwp) THEN
633!-$$            WRITE(numout,*)
634!-$$            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
635!-$$            WRITE(numout,*) '~~~~~~~~~~~~'
636!-$$         ENDIF
637
638         zdt = rdt
639         IF( nacc == 1 )   zdt = rdtmin
640
641         ! Reference latitude
642         ! ------------------
643         !                                           ! =======================
644         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
645            !                                        ! =======================
646
647            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
648            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
649            IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole
650            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
651            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
652            zphi(:) = 0.e0
653            DO ji = mi0(iline), mi1(iline) 
654               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
655               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ?
656               IF( jp_cfg == 05 ) THEN
657                  DO jj = mj0(jpjdta), mj1(jpjdta) 
658                     zphi( jj ) = zphi(mj0(jpjdta-1)) + (zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)))/2.
659                     zphi( jj ) = MIN( zphi(jj), 90.)
660                  END DO
661               END IF
662               IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
663                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 
664                     zphi( jj ) = 88.5e0
665                  END DO
666                  DO jj = mj0(jpjdta  ), mj1(jpjdta  ) 
667                     zphi( jj ) = 89.5e0
668                  END DO
669               END IF
670            END DO
671            ! provide the correct zphi to all local domains
672#if defined key_mpp_mpi
673            CALL mpp_sum( zphi, jpj, ncomm_znl )       
674#endif
675
676            !                                        ! =======================
677         ELSE                                        !   OTHER configurations
678            !                                        ! =======================
679            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
680            !
681         ENDIF
682         !
683         ! Work only on westmost processor (will not work if mppini2 is used)
684#if defined key_mpp_mpi
685         IF ( l_znl_root ) THEN 
686#endif
687            !
688            ! OPEN netcdf file
689            ! ----------------
690            ! Define frequency of output and means
691            zsto = nf_ptr * zdt
692            IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!)
693               clop      = "ave(only(x))"
694               clop_once = "once(only(x))"
695            ELSE                       ! no use of the mask value (require less cpu time)
696               clop      = "ave(x)"       
697               clop_once = "once"
698            ENDIF
699
700            zout = nf_ptr_wri * zdt
701            zfoo(:) = 0.e0
702
703            ! Compute julian date from starting date of the run
704
705            CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
706            zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
707
708            CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' )
709            IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam
710
711            ! Horizontal grid : zphi()
712            CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
713               1, 1, 1, jpj, niter, zjulian, zdt*nf_ptr, nhoridz, numptr, domain_id=nidom_ptr)
714            ! Vertical grids : gdept_0, gdepw_0
715            CALL histvert( numptr, "deptht", "Vertical T levels",   &
716               "m", jpk, gdept_0, ndepidzt, "down" )
717            CALL histvert( numptr, "depthw", "Vertical W levels",   &
718               "m", jpk, gdepw_0, ndepidzw, "down" )
719
720            !
721            CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex  , ndim  )      ! Lat-Depth
722            CALL wheneq ( jpj    , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h )     ! Lat
723
724            IF (ln_subbas) THEN
725               z_1 (:,1) = 1.0e0
726               WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0
727               DO jk = 2, jpk
728                  z_1 (:,jk) = z_1 (:,1)
729               END DO
730
731               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)         , 1.e0), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth
732               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth
733               CALL wheneq ( jpj    , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
734
735               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)         , 1.e0), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth
736               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth
737               CALL wheneq ( jpj    , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
738
739               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)         , 1.e0), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth
740               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth
741               CALL wheneq ( jpj    , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
742
743               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)         , 1.e0), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth
744               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth
745               CALL wheneq ( jpj    , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
746
747            ENDIF
748
749            !
750#if defined key_diaeiv
751            cl_comment = ' (Bolus part included)'
752#else
753            cl_comment = '                      '
754#endif
755            !  Zonal mean T and S
756
757            IF ( ln_diaznl ) THEN
758               CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
759                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
760               CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
761                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
762
763               CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   &
764                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
765
766               IF (ln_subbas) THEN
767                  CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   &
768                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
769                  CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   &
770                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
771                  CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   &
772                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
773
774                  CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   &
775                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
776                  CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   &
777                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
778                  CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   &
779                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
780
781                  CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   &
782                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
783                  CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   &
784                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
785                  CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   &
786                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
787
788                  CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   &
789                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
790                  CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   &
791                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
792                  CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   &
793                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
794               ENDIF
795
796            ENDIF
797
798            !  Meridional Stream-Function (Eulerian and Bolus)
799
800            CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   &
801               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
802            IF( ln_subbas .AND. ln_diaznl ) THEN
803               CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   &
804                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
805               CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   &
806                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
807               CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   &
808                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
809               CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,&
810                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
811            ENDIF
812
813            !  Heat transport
814
815            CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
816               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
817            CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
818               "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
819            IF ( ln_ptrcomp ) THEN
820               CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
821                  "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
822            END IF
823            IF( ln_subbas ) THEN
824               CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  &
825                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
826               CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  &
827                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
828               CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  &
829                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
830               CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), &
831                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
832            ENDIF
833
834
835            !  Salt transport
836
837            CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
838               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
839            CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
840               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
841            IF ( ln_ptrcomp ) THEN
842               CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
843                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
844            END IF
845#if defined key_diaeiv
846            ! Eddy induced velocity
847            CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   &
848               "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
849            CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
850               "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
851            CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
852               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
853#endif
854            IF( ln_subbas ) THEN
855               CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  &
856                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
857               CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   &
858                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
859               CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    &
860                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
861               CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  &
862                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
863            ENDIF
864
865            CALL histend( numptr )
866
867         END IF
868#if defined key_mpp_mpi
869      END IF
870#endif
871
872#if defined key_mpp_mpi
873      IF( MOD( itmod, nf_ptr ) == 0 .AND. l_znl_root ) THEN
874#else
875      IF( MOD( itmod, nf_ptr ) == 0  ) THEN
876#endif
877         niter = niter + 1
878
879!-$$         IF(lwp) THEN
880!-$$            WRITE(numout,*)
881!-$$            WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, &
882!-$$               & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter
883!-$$            WRITE(numout,*) '~~~~~~~~~~'
884!-$$            WRITE(numout,*)
885!-$$         ENDIF
886
887         IF (ln_diaznl ) THEN
888            CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex )
889            CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo  , ndim, ndex )
890            CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo  , ndim, ndex )
891
892            IF (ln_subbas) THEN
893               CALL histwrite( numptr, "zosrfatl", niter, surf_jk_atl, ndim_atl, ndex_atl )
894               CALL histwrite( numptr, "zosrfpac", niter, surf_jk_pac, ndim_pac, ndex_pac )
895               CALL histwrite( numptr, "zosrfind", niter, surf_jk_ind, ndim_ind, ndex_ind )
896               CALL histwrite( numptr, "zosrfipc", niter, surf_jk_ipc, ndim_ipc, ndex_ipc )
897
898               CALL histwrite( numptr, "zotematl", niter, tn_jk_atl  , ndim_atl, ndex_atl )
899               CALL histwrite( numptr, "zosalatl", niter, sn_jk_atl  , ndim_atl, ndex_atl )
900               CALL histwrite( numptr, "zotempac", niter, tn_jk_pac  , ndim_pac, ndex_pac )
901               CALL histwrite( numptr, "zosalpac", niter, sn_jk_pac  , ndim_pac, ndex_pac )
902               CALL histwrite( numptr, "zotemind", niter, tn_jk_ind  , ndim_ind, ndex_ind )
903               CALL histwrite( numptr, "zosalind", niter, sn_jk_ind  , ndim_ind, ndex_ind )
904               CALL histwrite( numptr, "zotemipc", niter, tn_jk_ipc  , ndim_ipc, ndex_ipc )
905               CALL histwrite( numptr, "zosalipc", niter, sn_jk_ipc  , ndim_ipc, ndex_ipc )
906            END IF
907         ENDIF
908
909         ! overturning outputs:
910         CALL histwrite( numptr, "zomsfglo", niter, v_msf_glo, ndim, ndex )
911         IF( ln_subbas .AND. ln_diaznl ) THEN
912            CALL histwrite( numptr, "zomsfatl", niter, v_msf_atl , ndim_atl_30, ndex_atl_30 )
913            CALL histwrite( numptr, "zomsfpac", niter, v_msf_pac , ndim_pac_30, ndex_pac_30 )
914            CALL histwrite( numptr, "zomsfind", niter, v_msf_ind , ndim_ind_30, ndex_ind_30 )
915            CALL histwrite( numptr, "zomsfipc", niter, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 )
916         ENDIF
917#if defined key_diaeiv
918         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv_glo, ndim  , ndex   )
919#endif
920
921
922         ! heat transport outputs:
923         IF( ln_subbas ) THEN
924            CALL histwrite( numptr, "sohtatl", niter, ht_atl  , ndim_h_atl_30, ndex_h_atl_30 )
925            CALL histwrite( numptr, "sohtpac", niter, ht_pac  , ndim_h_pac_30, ndex_h_pac_30 )
926            CALL histwrite( numptr, "sohtind", niter, ht_ind  , ndim_h_ind_30, ndex_h_ind_30 )
927            CALL histwrite( numptr, "sohtipc", niter, ht_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 )
928            CALL histwrite( numptr, "sostatl", niter, st_atl  , ndim_h_atl_30, ndex_h_atl_30 )
929            CALL histwrite( numptr, "sostpac", niter, st_pac  , ndim_h_pac_30, ndex_h_pac_30 )
930            CALL histwrite( numptr, "sostind", niter, st_ind  , ndim_h_ind_30, ndex_h_ind_30 )
931            CALL histwrite( numptr, "sostipc", niter, st_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 )
932         ENDIF
933
934         CALL histwrite( numptr, "sophtadv", niter, pht_adv     , ndim_h, ndex_h )
935         CALL histwrite( numptr, "sophtldf", niter, pht_ldf     , ndim_h, ndex_h )
936         CALL histwrite( numptr, "sopstadv", niter, pst_adv     , ndim_h, ndex_h )
937         CALL histwrite( numptr, "sopstldf", niter, pst_ldf     , ndim_h, ndex_h )
938         IF ( ln_ptrcomp ) THEN
939            CALL histwrite( numptr, "sopstove", niter, pst_ove_glo , ndim_h, ndex_h )
940            CALL histwrite( numptr, "sophtove", niter, pht_ove_glo , ndim_h, ndex_h )
941         ENDIF
942#if defined key_diaeiv
943         CALL histwrite( numptr, "sophteiv", niter, pht_eiv_glo  , ndim_h, ndex_h )
944         CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo  , ndim_h, ndex_h )
945#endif
946         !
947      ENDIF
948      !
949   END SUBROUTINE dia_ptr_wri
950
951   !!======================================================================
952END MODULE diaptr
Note: See TracBrowser for help on using the repository browser.