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/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 @ 6736

Last change on this file since 6736 was 6736, checked in by jamesharle, 8 years ago

FASTNEt code modifications
  • Property svn:keywords set to Id
File size: 41.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 ldftra_oce      ! ocean active tracers: lateral physics
29   USE ldfdyn_oce      ! ocean dynamics: lateral physics
30   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
31   USE sol_oce         ! solver variables
32   USE sbc_oce         ! Surface boundary condition: ocean fields
33   USE sbc_ice         ! Surface boundary condition: ice fields
34   USE sbcssr          ! restoring term toward SST/SSS climatology
35   USE phycst          ! physical constants
36   USE zdfmxl          ! mixed layer
37   USE dianam          ! build name of file (routine)
38   USE zdfddm          ! vertical  physics: double diffusion
39   USE diahth          ! thermocline diagnostics
40   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
41   USE in_out_manager  ! I/O manager
42   USE diadimg         ! dimg direct access file format output
43   USE diaar5, ONLY :   lk_diaar5
44   USE iom
45   USE ioipsl
46#if defined key_lim2
47   USE limwri_2 
48#endif
49   USE lib_mpp         ! MPP library
50   USE timing          ! preformance summary
51   USE wrk_nemo        ! working array
52
53   IMPLICIT NONE
54   PRIVATE
55
56   PUBLIC   dia_wri                 ! routines called by step.F90
57   PUBLIC   dia_wri_state
58   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
59
60   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
61   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
62   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
63   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
64   INTEGER ::   ndex(1)                              ! ???
65   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
66   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
67
68   !! * Substitutions
69#  include "zdfddm_substitute.h90"
70#  include "domzgr_substitute.h90"
71#  include "vectopt_loop_substitute.h90"
72   !!----------------------------------------------------------------------
73   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
74   !! $Id $
75   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
76   !!----------------------------------------------------------------------
77CONTAINS
78
79   INTEGER FUNCTION dia_wri_alloc()
80      !!----------------------------------------------------------------------
81      INTEGER, DIMENSION(2) :: ierr
82      !!----------------------------------------------------------------------
83      !
84      ierr = 0
85      !
86      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
87         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
88         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
89         !
90      dia_wri_alloc = MAXVAL(ierr)
91      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc )
92      !
93  END FUNCTION dia_wri_alloc
94
95#if defined key_dimgout
96   !!----------------------------------------------------------------------
97   !!   'key_dimgout'                                      DIMG output file
98   !!----------------------------------------------------------------------
99#   include "diawri_dimg.h90"
100
101#else
102   !!----------------------------------------------------------------------
103   !!   Default option                                   NetCDF output file
104   !!----------------------------------------------------------------------
105# if defined key_iomput
106   !!----------------------------------------------------------------------
107   !!   'key_iomput'                                        use IOM library
108   !!----------------------------------------------------------------------
109
110   SUBROUTINE dia_wri( kt )
111      !!---------------------------------------------------------------------
112      !!                  ***  ROUTINE dia_wri  ***
113      !!                   
114      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
115      !!      NETCDF format is used by default
116      !!
117      !! ** Method  :  use iom_put
118      !!----------------------------------------------------------------------
119      !!
120      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
121      !!
122      INTEGER                      ::   ji, jj, jk              ! dummy loop indices
123      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !
124      !!
125      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d       ! 2D workspace
126      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
127      !!----------------------------------------------------------------------
128      !
129      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
130      !
131      CALL wrk_alloc( jpi , jpj      , z2d )
132      CALL wrk_alloc( jpi , jpj, jpk , z3d )
133      !
134      ! Output the initial state and forcings
135      IF( ninist == 1 ) THEN                       
136         CALL dia_wri_state( 'output.init', kt )
137         ninist = 0
138      ENDIF
139
140      CALL iom_put( "toce"   , tsn(:,:,:,jp_tem)                     )    ! temperature
141      CALL iom_put( "soce"   , tsn(:,:,:,jp_sal)                     )    ! salinity
142      CALL iom_put( "sst"    , tsn(:,:,1,jp_tem)                     )    ! sea surface temperature
143      CALL iom_put( "sst2"   , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) )    ! square of sea surface temperature
144      CALL iom_put( "sss"    , tsn(:,:,1,jp_sal)                     )    ! sea surface salinity
145      CALL iom_put( "sss2"   , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) )    ! square of sea surface salinity
146      CALL iom_put( "uoce"   , un                                    )    ! i-current     
147      CALL iom_put( "voce"   , vn                                    )    ! j-current
148     
149      CALL iom_put( "avt"    , avt                                   )    ! T vert. eddy diff. coef.
150      CALL iom_put( "avm"    , avmu                                  )    ! T vert. eddy visc. coef.
151      IF( lk_zdfddm ) THEN
152         CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef.
153      ENDIF
154
155      DO jj = 2, jpjm1                                    ! sst gradient
156         DO ji = fs_2, fs_jpim1   ! vector opt.
157            zztmp      = tsn(ji,jj,1,jp_tem)
158            zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  )
159            zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1)
160            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
161               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
162         END DO
163      END DO
164      CALL lbc_lnk( z2d, 'T', 1. )
165      CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient
166!CDIR NOVERRCHK
167      z2d(:,:) = SQRT( z2d(:,:) )
168      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
169
170      IF( lk_diaar5 ) THEN
171         z3d(:,:,jpk) = 0.e0
172         DO jk = 1, jpkm1
173            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk)
174         END DO
175         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
176         zztmp = 0.5 * rcp
177         z2d(:,:) = 0.e0 
178         DO jk = 1, jpkm1
179            DO jj = 2, jpjm1
180               DO ji = fs_2, fs_jpim1   ! vector opt.
181                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
182               END DO
183            END DO
184         END DO
185         CALL lbc_lnk( z2d, 'U', -1. )
186         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction
187         DO jk = 1, jpkm1
188            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk)
189         END DO
190         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
191         z2d(:,:) = 0.e0 
192         DO jk = 1, jpkm1
193            DO jj = 2, jpjm1
194               DO ji = fs_2, fs_jpim1   ! vector opt.
195                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
196               END DO
197            END DO
198         END DO
199         CALL lbc_lnk( z2d, 'V', -1. )
200         CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction
201      ENDIF
202      !
203      CALL wrk_dealloc( jpi , jpj      , z2d )
204      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
205      !
206      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
207      !
208   END SUBROUTINE dia_wri
209
210#else
211   !!----------------------------------------------------------------------
212   !!   Default option                                  use IOIPSL  library
213   !!----------------------------------------------------------------------
214
215   SUBROUTINE dia_wri( kt )
216      !!---------------------------------------------------------------------
217      !!                  ***  ROUTINE dia_wri  ***
218      !!                   
219      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
220      !!      NETCDF format is used by default
221      !!
222      !! ** Method  :   At the beginning of the first time step (nit000),
223      !!      define all the NETCDF files and fields
224      !!      At each time step call histdef to compute the mean if ncessary
225      !!      Each nwrite time step, output the instantaneous or mean fields
226      !!----------------------------------------------------------------------
227      !!
228      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
229      !!
230      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
231      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
232      INTEGER  ::   inum = 11                                ! temporary logical unit
233      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
234      INTEGER  ::   ierr                                     ! error code return from allocation
235      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
236      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
237      !!
238      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
239      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
240      !!----------------------------------------------------------------------
241      !
242      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
243      !
244      CALL wrk_alloc( jpi , jpj      , zw2d )
245      IF ( ln_traldf_gdia )  call wrk_alloc( jpi , jpj , jpk  , zw3d )
246      !
247      ! Output the initial state and forcings
248      IF( ninist == 1 ) THEN                       
249         CALL dia_wri_state( 'output.init', kt )
250         ninist = 0
251      ENDIF
252      !
253      ! 0. Initialisation
254      ! -----------------
255
256      ! local variable for debugging
257      ll_print = .FALSE.
258      ll_print = ll_print .AND. lwp
259
260      ! Define frequency of output and means
261      zdt = rdt
262      IF( nacc == 1 ) zdt = rdtmin
263      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
264      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
265      ENDIF
266#if defined key_diainstant
267      zsto = nwrite * zdt
268      clop = "inst("//TRIM(clop)//")"
269#else
270      zsto=zdt
271      clop = "ave("//TRIM(clop)//")"
272#endif
273      zout = nwrite * zdt
274      zmax = ( nitend - nit000 + 1 ) * zdt
275
276      ! Define indices of the horizontal output zoom and vertical limit storage
277      iimi = 1      ;      iima = jpi
278      ijmi = 1      ;      ijma = jpj
279      ipk = jpk
280
281      ! define time axis
282      it = kt
283      itmod = kt - nit000 + 1
284
285
286      ! 1. Define NETCDF files and fields at beginning of first time step
287      ! -----------------------------------------------------------------
288
289      IF( kt == nit000 ) THEN
290
291         ! Define the NETCDF files (one per grid)
292
293         ! Compute julian date from starting date of the run
294         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
295         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
296         IF(lwp)WRITE(numout,*)
297         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
298            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
299         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
300                                 ' limit storage in depth = ', ipk
301
302         ! WRITE root name in date.file for use by postpro
303         IF(lwp) THEN
304            CALL dia_nam( clhstnam, nwrite,' ' )
305            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
306            WRITE(inum,*) clhstnam
307            CLOSE(inum)
308         ENDIF
309
310         ! Define the T grid FILE ( nid_T )
311
312         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
313         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
314         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
315            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
316            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
317         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
318            &           "m", ipk, gdept_0, nz_T, "down" )
319         !                                                            ! Index of ocean points
320         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
321         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
322
323         ! Define the U grid FILE ( nid_U )
324
325         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
326         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
327         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
328            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
329            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
330         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
331            &           "m", ipk, gdept_0, nz_U, "down" )
332         !                                                            ! Index of ocean points
333         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
334         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
335
336         ! Define the V grid FILE ( nid_V )
337
338         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
339         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
340         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
341            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
342            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
343         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
344            &          "m", ipk, gdept_0, nz_V, "down" )
345         !                                                            ! Index of ocean points
346         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
347         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
348
349         ! Define the W grid FILE ( nid_W )
350
351         CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename
352         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
353         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
354            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
355            &          nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
356         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
357            &          "m", ipk, gdepw_0, nz_W, "down" )
358
359
360         ! Declare all the output fields as NETCDF variables
361
362         !                                                                                      !!! nid_T : 3D
363         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
364            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
365         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
366            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
367         !                                                                                      !!! nid_T : 2D
368         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
369            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
370         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
371            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
372         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
373            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
374!!$#if defined key_lim3 || defined key_lim2
375!!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
376!!$         !    internal damping to Levitus that can be diagnosed from others
377!!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
378!!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt
379!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
380!!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass
381!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
382!!$#endif
383         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
384            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
385!!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
386!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
387         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf)
388            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
389         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn
390            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
391         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
392            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
393         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
394            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
395         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
396            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
397         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
398            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
399         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
400            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
401         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
402            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
403         IF( ln_ssr ) THEN
404            IF( nn_sstr /= 0 ) THEN
405               CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping", "W/m2"      ,   &  ! qrp
406                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
407            ENDIF
408            IF( nn_sssr /= 0 ) THEN
409               CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"  , "Kg/m2/s",   &  ! erp
410                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
411               CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"   , "Kg/m2/s",   &  ! erp * sn
412                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
413            ENDIF
414         ENDIF
415         clmx ="l_max(only(x))"    ! max index on a period
416         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX
417            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
418#if defined key_diahth
419         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   &  ! hth
420            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
421         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   &  ! hd20
422            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
423         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   &  ! hd28
424            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
425         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   &  ! htc3
426            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
427#endif
428
429#if defined key_coupled 
430# if defined key_lim3
431         Must be adapted to LIM3
432# else
433         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
434            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
435         CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
436            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
437# endif 
438#endif
439
440         CALL histend( nid_T, snc4chunks=snc4set )
441
442         !                                                                                      !!! nid_U : 3D
443         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
444            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
445         IF( ln_traldf_gdia ) THEN
446            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
447                 &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
448         ELSE
449#if defined key_diaeiv
450            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
451            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
452#endif
453         END IF
454         !                                                                                      !!! nid_U : 2D
455         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
456            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
457
458         CALL histend( nid_U, snc4chunks=snc4set )
459
460         !                                                                                      !!! nid_V : 3D
461         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
462            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
463         IF( ln_traldf_gdia ) THEN
464            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
465                 &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
466         ELSE 
467#if defined key_diaeiv
468            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
469            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
470#endif
471         END IF
472         !                                                                                      !!! nid_V : 2D
473         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
474            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
475
476         CALL histend( nid_V, snc4chunks=snc4set )
477
478         !                                                                                      !!! nid_W : 3D
479         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
480            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
481         IF( ln_traldf_gdia ) THEN
482            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
483                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
484         ELSE
485#if defined key_diaeiv
486            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
487                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
488#endif
489         END IF
490         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
491            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
492         CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avmu
493            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
494
495         IF( lk_zdfddm ) THEN
496            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
497               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
498         ENDIF
499         !                                                                                      !!! nid_W : 2D
500#if defined key_traldf_c2d
501         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
502            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
503# if defined key_traldf_eiv 
504            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
505               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
506# endif
507#endif
508
509         CALL histend( nid_W, snc4chunks=snc4set )
510
511         IF(lwp) WRITE(numout,*)
512         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
513         IF(ll_print) CALL FLUSH(numout )
514
515      ENDIF
516
517      ! 2. Start writing data
518      ! ---------------------
519
520      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
521      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
522      ! donne le nombre d'elements, et ndex la liste des indices a sortir
523
524      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
525         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
526         WRITE(numout,*) '~~~~~~ '
527      ENDIF
528
529      ! Write fields on T grid
530      CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem), ndim_T , ndex_T  )   ! temperature
531      CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal), ndim_T , ndex_T  )   ! salinity
532      CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem), ndim_hT, ndex_hT )   ! sea surface temperature
533      CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity
534      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
535!!$#if  defined key_lim3 || defined key_lim2
536!!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux
537!!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
538!!$#endif
539      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
540!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
541      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux
542      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
543      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
544      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
545      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
546      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
547      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
548      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
549      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
550      IF( ln_ssr ) THEN
551         IF( nn_sstr /= 0 ) THEN
552            CALL histwrite( nid_T, "sohefldp", it, qrp     , ndim_hT, ndex_hT )   ! heat flux damping
553         ENDIF
554         IF( nn_sssr /= 0 ) THEN
555            CALL histwrite( nid_T, "sowafldp", it, erp     , ndim_hT, ndex_hT )   ! freshwater flux damping
556            zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
557            CALL histwrite( nid_T, "sosafldp", it, zw2d    , ndim_hT, ndex_hT )   ! salt flux damping
558         ENDIF
559      ENDIF
560      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
561      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
562
563#if defined key_diahth
564      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
565      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
566      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
567      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
568#endif
569
570#if defined key_coupled 
571# if defined key_lim3
572      Must be adapted for LIM3
573      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature
574      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo
575# else
576      CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
577      CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
578# endif
579#endif
580         ! Write fields on U grid
581      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
582      IF( ln_traldf_gdia ) THEN
583         IF (.not. ALLOCATED(psix_eiv))THEN
584            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
585            IF( lk_mpp   )   CALL mpp_sum ( ierr )
586            IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')
587            psix_eiv(:,:,:) = 0.0_wp
588            psiy_eiv(:,:,:) = 0.0_wp
589         ENDIF
590         DO jk=1,jpkm1
591            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
592         END DO
593         zw3d(:,:,jpk) = 0._wp
594         CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current
595      ELSE
596#if defined key_diaeiv
597         CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current
598#endif
599      ENDIF
600      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
601
602         ! Write fields on V grid
603      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
604      IF( ln_traldf_gdia ) THEN
605         DO jk=1,jpk-1
606            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
607         END DO
608         zw3d(:,:,jpk) = 0._wp
609         CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current
610      ELSE
611#if defined key_diaeiv
612         CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current
613#endif
614      ENDIF
615      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
616
617         ! Write fields on W grid
618      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
619      IF( ln_traldf_gdia ) THEN
620         DO jk=1,jpk-1
621            DO jj = 2, jpjm1
622               DO ji = fs_2, fs_jpim1  ! vector opt.
623                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &
624                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
625               END DO
626            END DO
627         END DO
628         zw3d(:,:,jpk) = 0._wp
629         CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current
630      ELSE
631#   if defined key_diaeiv
632         CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
633#   endif
634      ENDIF
635      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
636      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
637      IF( lk_zdfddm ) THEN
638         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
639      ENDIF
640#if defined key_traldf_c2d
641      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
642# if defined key_traldf_eiv
643         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
644# endif
645#endif
646
647      ! 3. Close all files
648      ! ---------------------------------------
649      IF( kt == nitend ) THEN
650         CALL histclo( nid_T )
651         CALL histclo( nid_U )
652         CALL histclo( nid_V )
653         CALL histclo( nid_W )
654      ENDIF
655      !
656      CALL wrk_dealloc( jpi , jpj      , zw2d )
657      IF ( ln_traldf_gdia )  call wrk_dealloc( jpi , jpj , jpk  , zw3d )
658      !
659      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
660      !
661   END SUBROUTINE dia_wri
662# endif
663
664#endif
665
666   SUBROUTINE dia_wri_state( cdfile_name, kt )
667      !!---------------------------------------------------------------------
668      !!                 ***  ROUTINE dia_wri_state  ***
669      !!       
670      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
671      !!      the instantaneous ocean state and forcing fields.
672      !!        Used to find errors in the initial state or save the last
673      !!      ocean state in case of abnormal end of a simulation
674      !!
675      !! ** Method  :   NetCDF files using ioipsl
676      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
677      !!      File 'output.abort.nc' is created in case of abnormal job end
678      !!----------------------------------------------------------------------
679      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
680      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
681      !!
682      CHARACTER (len=32) :: clname
683      CHARACTER (len=40) :: clop
684      INTEGER  ::   id_i , nz_i, nh_i       
685      INTEGER, DIMENSION(1) ::   idex             ! local workspace
686      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt
687      !!----------------------------------------------------------------------
688      !
689      ! 0. Initialisation
690      ! -----------------
691
692      ! Define name, frequency of output and means
693      clname = cdfile_name
694      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
695      zdt  = rdt
696      zsto = rdt
697      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
698      zout = rdt
699      zmax = ( nitend - nit000 + 1 ) * zdt
700
701      IF(lwp) WRITE(numout,*)
702      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
703      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
704      IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc'
705
706
707      ! 1. Define NETCDF files and fields at beginning of first time step
708      ! -----------------------------------------------------------------
709
710      ! Compute julian date from starting date of the run
711      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis
712      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
713      CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
714          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
715      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
716          "m", jpk, gdept_0, nz_i, "down")
717
718      ! Declare all the output fields as NetCDF variables
719
720      CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity
721         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
722      CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature
723         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
724      CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh
725         &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout )
726      CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current
727         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
728      CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current
729         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
730      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
731         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
732      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater
733         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
734      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
735         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
736      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
737         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
738      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i
739         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
740      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
741         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
742      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
743         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
744
745#if defined key_lim2
746      CALL lim_wri_state_2( kt, id_i, nh_i )
747#else
748      CALL histend( id_i, snc4chunks=snc4set )
749#endif
750
751      ! 2. Start writing data
752      ! ---------------------
753      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de
754      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
755      ! donne le nombre d'elements, et idex la liste des indices a sortir
756      idex(1) = 1   ! init to avoid compil warning
757
758      ! Write all fields on T grid
759      CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature
760      CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity
761      CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height
762      CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity
763      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity
764      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity
765      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget
766      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux
767      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux
768      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction
769      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
770      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
771
772      ! 3. Close the file
773      ! -----------------
774      CALL histclo( id_i )
775#if ! defined key_iomput && ! defined key_dimgout
776      IF( ninist /= 1  ) THEN
777         CALL histclo( nid_T )
778         CALL histclo( nid_U )
779         CALL histclo( nid_V )
780         CALL histclo( nid_W )
781      ENDIF
782#endif
783      !
784
785   END SUBROUTINE dia_wri_state
786   !!======================================================================
787END MODULE diawri
Note: See TracBrowser for help on using the repository browser.