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.
diawri.F90 in branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/SAS_SRC – NEMO

source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/SAS_SRC/diawri.F90 @ 9012

Last change on this file since 9012 was 8885, checked in by clem, 6 years ago

remove useless references to clem's comments

  • Property svn:keywords set to Id
File size: 21.6 KB
Line 
1MODULE diawri
2   !!======================================================================
3   !!                     ***  MODULE  diawri  ***
4   !! Ocean diagnostics :  write ocean output files
5   !!=====================================================================
6   !! History :  OPA  ! 1991-03  (M.-A. Foujols)  Original code
7   !!            4.0  ! 1991-11  (G. Madec)
8   !!                 ! 1992-06  (M. Imbard)  correction restart file
9   !!                 ! 1992-07  (M. Imbard)  split into diawri and rstwri
10   !!                 ! 1993-03  (M. Imbard)  suppress writibm
11   !!                 ! 1998-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
12   !!                 ! 1999-02  (E. Guilyardi)  name of netCDF files + variables
13   !!            8.2  ! 2000-06  (M. Imbard)  Original code (diabort.F)
14   !!   NEMO     1.0  ! 2002-06  (A.Bozec, E. Durand)  Original code (diainit.F)
15   !!             -   ! 2002-09  (G. Madec)  F90: Free form and module
16   !!             -   ! 2002-12  (G. Madec)  merge of diabort and diainit, F90
17   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
18   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
19   !!----------------------------------------------------------------------
20
21   !!----------------------------------------------------------------------
22   !!   dia_wri       : create the standart output files
23   !!   dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
24   !!----------------------------------------------------------------------
25   USE oce             ! ocean dynamics and tracers
26   USE dom_oce         ! ocean space and time domain
27   USE zdf_oce         ! ocean vertical physics
28   USE sbc_oce         ! Surface boundary condition: ocean fields
29   USE sbc_ice         ! Surface boundary condition: ice fields
30   USE sbcssr          ! restoring term toward SST/SSS climatology
31   USE phycst          ! physical constants
32   USE zdfmxl          ! mixed layer
33   USE dianam          ! build name of file (routine)
34   USE zdfddm          ! vertical  physics: double diffusion
35   USE diahth          ! thermocline diagnostics
36   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
37   USE in_out_manager  ! I/O manager
38   USE iom
39   USE ioipsl
40#if defined key_lim3
41   USE icewri
42#endif
43   USE lib_mpp         ! MPP library
44   USE timing          ! preformance summary
45   USE wrk_nemo        ! working array
46
47   IMPLICIT NONE
48   PRIVATE
49
50   PUBLIC   dia_wri                 ! routines called by step.F90
51   PUBLIC   dia_wri_state
52   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
53
54   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
55   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
56   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
57   INTEGER ::   ndex(1)                              ! ???
58   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
59
60   !! * Substitutions
61#  include "vectopt_loop_substitute.h90"
62   !!----------------------------------------------------------------------
63   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
64   !! $Id$
65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
66   !!----------------------------------------------------------------------
67CONTAINS
68
69   INTEGER FUNCTION dia_wri_alloc()
70      !!----------------------------------------------------------------------
71      INTEGER :: ierr
72      !!----------------------------------------------------------------------
73      !
74      ALLOCATE( ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc )
75      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc )
76      !
77  END FUNCTION dia_wri_alloc
78
79   !!----------------------------------------------------------------------
80   !!   Default option                                   NetCDF output file
81   !!----------------------------------------------------------------------
82# if defined key_iomput
83   !!----------------------------------------------------------------------
84   !!   'key_iomput'                                        use IOM library
85   !!----------------------------------------------------------------------
86
87   SUBROUTINE dia_wri( kt )
88      !!---------------------------------------------------------------------
89      !!                  ***  ROUTINE dia_wri  ***
90      !!                   
91      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
92      !!      NETCDF format is used by default
93      !!      Standalone surface scheme
94      !!
95      !! ** Method  :  use iom_put
96      !!----------------------------------------------------------------------
97      !!
98      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
99      !!----------------------------------------------------------------------
100      !
101      ! Output the initial state and forcings
102      IF( ninist == 1 ) THEN
103         CALL dia_wri_state( 'output.init', kt )
104         ninist = 0
105      ENDIF
106      !
107   END SUBROUTINE dia_wri
108
109#else
110   !!----------------------------------------------------------------------
111   !!   Default option                                  use IOIPSL  library
112   !!----------------------------------------------------------------------
113
114   SUBROUTINE dia_wri( kt )
115      !!---------------------------------------------------------------------
116      !!                  ***  ROUTINE dia_wri  ***
117      !!                   
118      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
119      !!      NETCDF format is used by default
120      !!
121      !! ** Method  :   At the beginning of the first time step (nit000),
122      !!      define all the NETCDF files and fields
123      !!      At each time step call histdef to compute the mean if ncessary
124      !!      Each nwrite time step, output the instantaneous or mean fields
125      !!----------------------------------------------------------------------
126      !!
127      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
128      !!
129      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
130      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
131      INTEGER  ::   inum = 11                                ! temporary logical unit
132      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
133      INTEGER  ::   ierr                                     ! error code return from allocation
134      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
135      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
136      !!----------------------------------------------------------------------
137      !
138      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
139      !
140      ! Output the initial state and forcings
141      IF( ninist == 1 ) THEN                       
142         CALL dia_wri_state( 'output.init', kt )
143         ninist = 0
144      ENDIF
145      !
146      ! 0. Initialisation
147      ! -----------------
148
149      ! local variable for debugging
150      ll_print = .FALSE.
151      ll_print = ll_print .AND. lwp
152
153      ! Define frequency of output and means
154      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
155      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
156      ENDIF
157#if defined key_diainstant
158      zsto = nwrite * rdt
159      clop = "inst("//TRIM(clop)//")"
160#else
161      zsto=rdt
162      clop = "ave("//TRIM(clop)//")"
163#endif
164      zout = nwrite * rdt
165      zmax = ( nitend - nit000 + 1 ) * rdt
166
167      ! Define indices of the horizontal output zoom and vertical limit storage
168      iimi = 1      ;      iima = jpi
169      ijmi = 1      ;      ijma = jpj
170      ipk = jpk
171
172      ! define time axis
173      it = kt
174      itmod = kt - nit000 + 1
175
176
177      ! 1. Define NETCDF files and fields at beginning of first time step
178      ! -----------------------------------------------------------------
179
180      IF( kt == nit000 ) THEN
181
182         ! Define the NETCDF files (one per grid)
183
184         ! Compute julian date from starting date of the run
185         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
186         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
187         IF(lwp)WRITE(numout,*)
188         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
189            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
190         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
191                                 ' limit storage in depth = ', ipk
192
193         ! WRITE root name in date.file for use by postpro
194         IF(lwp) THEN
195            CALL dia_nam( clhstnam, nwrite,' ' )
196            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
197            WRITE(inum,*) clhstnam
198            CLOSE(inum)
199         ENDIF
200
201         ! Define the T grid FILE ( nid_T )
202
203         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
204         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
205         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
206            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
207            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
208         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
209            &           "m", ipk, gdept_1d, nz_T, "down" )
210         !                                                            ! Index of ocean points
211         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
212
213         ! Define the U grid FILE ( nid_U )
214
215         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
216         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
217         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
218            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
219            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
220         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
221            &           "m", ipk, gdept_1d, nz_U, "down" )
222         !                                                            ! Index of ocean points
223         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
224
225         ! Define the V grid FILE ( nid_V )
226
227         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
228         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
229         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
230            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
231            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
232         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
233            &          "m", ipk, gdept_1d, nz_V, "down" )
234         !                                                            ! Index of ocean points
235         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
236
237         ! No W grid FILE
238
239         ! Declare all the output fields as NETCDF variables
240
241         !                                                                                      !!! nid_T : 3D
242         CALL histdef( nid_T, "sst_m", "Sea Surface temperature"            , "C"      ,   &  ! sst
243            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
244         CALL histdef( nid_T, "sss_m", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
245            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
246         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
247            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
248         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! (sfx)
249             &         jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
250         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
251            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
252         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
253            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
254         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
255            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
256         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
257            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
258
259         CALL histend( nid_T, snc4chunks=snc4set )
260
261         !                                                                                      !!! nid_U : 3D
262         CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s"   ,         &  ! ssu
263            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
264         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
265            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
266
267         CALL histend( nid_U, snc4chunks=snc4set )
268
269         !                                                                                      !!! nid_V : 3D
270         CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s",            &  ! ssv_m
271            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
272         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
273            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
274
275         CALL histend( nid_V, snc4chunks=snc4set )
276
277         IF(lwp) WRITE(numout,*)
278         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
279         IF(ll_print) CALL FLUSH(numout )
280
281      ENDIF
282
283      ! 2. Start writing data
284      ! ---------------------
285
286      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
287      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
288      ! donne le nombre d'elements, et ndex la liste des indices a sortir
289
290      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
291         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
292         WRITE(numout,*) '~~~~~~ '
293      ENDIF
294
295      ! Write fields on T grid
296      CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT )   ! sea surface temperature
297      CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT )   ! sea surface salinity
298      CALL histwrite( nid_T, "sowaflup", it, (emp - rnf )  , ndim_hT, ndex_hT )   ! upward water flux
299      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux
300                                                                                  ! (includes virtual salt flux beneath ice
301                                                                                  ! in linear free surface case)
302
303      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
304      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
305      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
306      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
307
308         ! Write fields on U grid
309      CALL histwrite( nid_U, "ssu_m"   , it, ssu_m         , ndim_hU, ndex_hU )   ! i-current speed
310      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
311
312         ! Write fields on V grid
313      CALL histwrite( nid_V, "ssv_m"   , it, ssv_m         , ndim_hV, ndex_hV )   ! j-current speed
314      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
315
316      ! 3. Close all files
317      ! ---------------------------------------
318      IF( kt == nitend ) THEN
319         CALL histclo( nid_T )
320         CALL histclo( nid_U )
321         CALL histclo( nid_V )
322      ENDIF
323      !
324      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
325      !
326   END SUBROUTINE dia_wri
327#endif
328
329   SUBROUTINE dia_wri_state( cdfile_name, kt )
330      !!---------------------------------------------------------------------
331      !!                 ***  ROUTINE dia_wri_state  ***
332      !!       
333      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
334      !!      the instantaneous ocean state and forcing fields.
335      !!        Used to find errors in the initial state or save the last
336      !!      ocean state in case of abnormal end of a simulation
337      !!
338      !! ** Method  :   NetCDF files using ioipsl
339      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
340      !!      File 'output.abort.nc' is created in case of abnormal job end
341      !!----------------------------------------------------------------------
342      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
343      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
344      !!
345      CHARACTER (len=32) :: clname
346      CHARACTER (len=40) :: clop
347      INTEGER  ::   id_i , nz_i, nh_i       
348      INTEGER, DIMENSION(1) ::   idex             ! local workspace
349      REAL(wp) ::   zsto, zout, zmax, zjulian
350      !!----------------------------------------------------------------------
351      !
352      IF( nn_timing == 1 )   CALL timing_start('dia_wri_state')
353
354      ! 0. Initialisation
355      ! -----------------
356
357      ! Define name, frequency of output and means
358      clname = cdfile_name
359      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
360      zsto = rdt
361      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
362      zout = rdt
363      zmax = ( nitend - nit000 + 1 ) * rdt
364
365      IF(lwp) WRITE(numout,*)
366      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
367      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
368      IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc'
369
370
371      ! 1. Define NETCDF files and fields at beginning of first time step
372      ! -----------------------------------------------------------------
373
374      ! Compute julian date from starting date of the run
375      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis
376      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
377      CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
378          1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
379      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
380          "m", jpk, gdept_1d, nz_i, "down")
381
382      ! Declare all the output fields as NetCDF variables
383
384      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater
385         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
386      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
387         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
388      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
389         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
390      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i
391         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
392      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
393         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
394      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
395         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
396
397#if defined key_lim3
398      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + lim but no-ice in child grid
399         CALL ice_wri_state( kt, id_i, nh_i )
400      ENDIF
401#else
402      CALL histend( id_i, snc4chunks=snc4set )
403#endif
404
405      ! 2. Start writing data
406      ! ---------------------
407      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de
408      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
409      ! donne le nombre d'elements, et idex la liste des indices a sortir
410      idex(1) = 1   ! init to avoid compil warning
411
412      ! Write all fields on T grid
413      CALL histwrite( id_i, "sowaflup", kt, emp              , jpi*jpj    , idex )    ! freshwater budget
414      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux
415      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux
416      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction
417      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
418      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
419
420      ! 3. Close the file
421      ! -----------------
422      CALL histclo( id_i )
423#if ! defined key_iomput
424      IF( ninist /= 1  ) THEN
425         CALL histclo( nid_T )
426         CALL histclo( nid_U )
427         CALL histclo( nid_V )
428      ENDIF
429#endif
430       
431      IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state')
432      !
433
434   END SUBROUTINE dia_wri_state
435   !!======================================================================
436END MODULE diawri
Note: See TracBrowser for help on using the repository browser.