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/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC – NEMO

source: branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/diawri.F90 @ 5845

Last change on this file since 5845 was 5845, checked in by gm, 8 years ago

#1613: vvl by default: suppression of domzgr_substitute.h90

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