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

Last change on this file since 1316 was 1316, checked in by smasson, 12 years ago

continue changeset:1312, see ticke:322

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