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

source: branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/SAS_SRC/diawri.F90 @ 5766

Last change on this file since 5766 was 5766, checked in by cetlod, 9 years ago

LDF: phasing the improvements/simplifications of TOP component

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