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

Last change on this file since 392 was 392, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

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