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 NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90 @ 12182

Last change on this file since 12182 was 12182, checked in by davestorkey, 4 years ago

2019/dev_r11943_MERGE_2019: Merge in dev_ASINTER-01-05_merge.
  • Property svn:keywords set to Id
File size: 56.8 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   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output
20   !!                 !                     change name of output variables in dia_wri_state
21   !!----------------------------------------------------------------------
22
23   !!----------------------------------------------------------------------
24   !!   dia_wri       : create the standart output files
25   !!   dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
26   !!----------------------------------------------------------------------
27   USE oce            ! ocean dynamics and tracers
28   USE isf_oce
29   USE isfcpl
30   USE abl            ! abl variables in case ln_abl = .true.
31   USE dom_oce        ! ocean space and time domain
32   USE phycst         ! physical constants
33   USE dianam         ! build name of file (routine)
34   USE diahth         ! thermocline diagnostics
35   USE dynadv   , ONLY: ln_dynadv_vec
36   USE icb_oce        ! Icebergs
37   USE icbdia         ! Iceberg budgets
38   USE ldftra         ! lateral physics: eddy diffusivity coef.
39   USE ldfdyn         ! lateral physics: eddy viscosity   coef.
40   USE sbc_oce        ! Surface boundary condition: ocean fields
41   USE sbc_ice        ! Surface boundary condition: ice fields
42   USE sbcssr         ! restoring term toward SST/SSS climatology
43   USE sbcwave        ! wave parameters
44   USE wet_dry        ! wetting and drying
45   USE zdf_oce        ! ocean vertical physics
46   USE zdfdrg         ! ocean vertical physics: top/bottom friction
47   USE zdfmxl         ! mixed layer
48   !
49   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
50   USE in_out_manager ! I/O manager
51   USE diatmb         ! Top,middle,bottom output
52   USE dia25h         ! 25h Mean output
53   USE iom            !
54   USE ioipsl         !
55
56#if defined key_si3
57   USE ice 
58   USE icewri 
59#endif
60   USE lib_mpp         ! MPP library
61   USE timing          ! preformance summary
62   USE diu_bulk        ! diurnal warm layer
63   USE diu_coolskin    ! Cool skin
64
65   IMPLICIT NONE
66   PRIVATE
67
68   PUBLIC   dia_wri                 ! routines called by step.F90
69   PUBLIC   dia_wri_state
70   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
71#if ! defined key_iomput   
72   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
73#endif
74   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
75   INTEGER ::          nb_T              , ndim_bT   ! grid_T file
76   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
77   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
78   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
79   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file   
80   INTEGER ::   ndex(1)                              ! ???
81   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
82   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
83   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
84   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
85
86   !! * Substitutions
87#  include "vectopt_loop_substitute.h90"
88   !!----------------------------------------------------------------------
89   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
90   !! $Id$
91   !! Software governed by the CeCILL license (see ./LICENSE)
92   !!----------------------------------------------------------------------
93CONTAINS
94
95#if defined key_iomput
96   !!----------------------------------------------------------------------
97   !!   'key_iomput'                                        use IOM library
98   !!----------------------------------------------------------------------
99   INTEGER FUNCTION dia_wri_alloc()
100      !
101      dia_wri_alloc = 0
102      !
103   END FUNCTION dia_wri_alloc
104
105   
106   SUBROUTINE dia_wri( kt, Kmm )
107      !!---------------------------------------------------------------------
108      !!                  ***  ROUTINE dia_wri  ***
109      !!                   
110      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
111      !!      NETCDF format is used by default
112      !!
113      !! ** Method  :  use iom_put
114      !!----------------------------------------------------------------------
115      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
116      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index
117      !!
118      INTEGER ::   ji, jj, jk       ! dummy loop indices
119      INTEGER ::   ikbot            ! local integer
120      REAL(wp)::   zztmp , zztmpx   ! local scalar
121      REAL(wp)::   zztmp2, zztmpy   !   -      -
122      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace
123      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace
124      !!----------------------------------------------------------------------
125      !
126      IF( ln_timing )   CALL timing_start('dia_wri')
127      !
128      ! Output the initial state and forcings
129      IF( ninist == 1 ) THEN                       
130         CALL dia_wri_state( Kmm, 'output.init' )
131         ninist = 0
132      ENDIF
133
134      ! Output of initial vertical scale factor
135      CALL iom_put("e3t_0", e3t_0(:,:,:) )
136      CALL iom_put("e3u_0", e3u_0(:,:,:) )
137      CALL iom_put("e3v_0", e3v_0(:,:,:) )
138      !
139      CALL iom_put( "e3t" , e3t(:,:,:,Kmm) )
140      CALL iom_put( "e3u" , e3u(:,:,:,Kmm) )
141      CALL iom_put( "e3v" , e3v(:,:,:,Kmm) )
142      CALL iom_put( "e3w" , e3w(:,:,:,Kmm) )
143      IF( iom_use("e3tdef") )   &
144         CALL iom_put( "e3tdef"  , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
145
146      IF( ll_wd ) THEN
147         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
148      ELSE
149         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height
150      ENDIF
151
152      IF( iom_use("wetdep") )   &                  ! wet depth
153         CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )
154     
155      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature
156      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature
157      IF ( iom_use("sbt") ) THEN
158         DO jj = 1, jpj
159            DO ji = 1, jpi
160               ikbot = mbkt(ji,jj)
161               z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
162            END DO
163         END DO
164         CALL iom_put( "sbt", z2d )                ! bottom temperature
165      ENDIF
166     
167      CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) )    ! 3D salinity
168      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity
169      IF ( iom_use("sbs") ) THEN
170         DO jj = 1, jpj
171            DO ji = 1, jpi
172               ikbot = mbkt(ji,jj)
173               z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
174            END DO
175         END DO
176         CALL iom_put( "sbs", z2d )                ! bottom salinity
177      ENDIF
178
179      IF ( iom_use("taubot") ) THEN                ! bottom stress
180         zztmp = rau0 * 0.25
181         z2d(:,:) = 0._wp
182         DO jj = 2, jpjm1
183            DO ji = fs_2, fs_jpim1   ! vector opt.
184               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
185                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
186                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
187                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
188               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
189               !
190            END DO
191         END DO
192         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
193         CALL iom_put( "taubot", z2d )           
194      ENDIF
195         
196      CALL iom_put( "uoce", uu(:,:,:,Kmm) )            ! 3D i-current
197      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current
198      IF ( iom_use("sbu") ) THEN
199         DO jj = 1, jpj
200            DO ji = 1, jpi
201               ikbot = mbku(ji,jj)
202               z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
203            END DO
204         END DO
205         CALL iom_put( "sbu", z2d )                ! bottom i-current
206      ENDIF
207     
208      CALL iom_put( "voce", vv(:,:,:,Kmm) )            ! 3D j-current
209      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current
210      IF ( iom_use("sbv") ) THEN
211         DO jj = 1, jpj
212            DO ji = 1, jpi
213               ikbot = mbkv(ji,jj)
214               z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
215            END DO
216         END DO
217         CALL iom_put( "sbv", z2d )                ! bottom j-current
218      ENDIF
219
220      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
221      !
222      CALL iom_put( "woce", ww )                   ! vertical velocity
223      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
224         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
225         z2d(:,:) = rau0 * e1e2t(:,:)
226         DO jk = 1, jpk
227            z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:)
228         END DO
229         CALL iom_put( "w_masstr" , z3d ) 
230         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
231      ENDIF
232      !
233      IF( ln_zad_Aimp ) ww = ww - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output
234
235      CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef.
236      CALL iom_put( "avs" , avs )                  ! S vert. eddy diff. coef.
237      CALL iom_put( "avm" , avm )                  ! T vert. eddy visc. coef.
238
239      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) )
240      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
241
242      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
243         DO jj = 2, jpjm1                                    ! sst gradient
244            DO ji = fs_2, fs_jpim1   ! vector opt.
245               zztmp  = ts(ji,jj,1,jp_tem,Kmm)
246               zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
247               zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
248               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
249                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
250            END DO
251         END DO
252         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
253         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
254         z2d(:,:) = SQRT( z2d(:,:) )
255         CALL iom_put( "sstgrad" ,  z2d )          ! module of sst gradient
256      ENDIF
257         
258      ! heat and salt contents
259      IF( iom_use("heatc") ) THEN
260         z2d(:,:)  = 0._wp 
261         DO jk = 1, jpkm1
262            DO jj = 1, jpj
263               DO ji = 1, jpi
264                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
265               END DO
266            END DO
267         END DO
268         CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2)
269      ENDIF
270
271      IF( iom_use("saltc") ) THEN
272         z2d(:,:)  = 0._wp 
273         DO jk = 1, jpkm1
274            DO jj = 1, jpj
275               DO ji = 1, jpi
276                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
277               END DO
278            END DO
279         END DO
280         CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
281      ENDIF
282      !
283      IF ( iom_use("eken") ) THEN
284         z3d(:,:,jpk) = 0._wp 
285         DO jk = 1, jpkm1
286            DO jj = 2, jpjm1
287               DO ji = fs_2, fs_jpim1   ! vector opt.
288                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
289                  z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
290                     &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
291                     &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
292                     &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
293               END DO
294            END DO
295         END DO
296         CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
297         CALL iom_put( "eken", z3d )                 ! kinetic energy
298      ENDIF
299      !
300      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence
301      !
302      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
303         z3d(:,:,jpk) = 0.e0
304         z2d(:,:) = 0.e0
305         DO jk = 1, jpkm1
306            z3d(:,:,jk) = rau0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk)
307            z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
308         END DO
309         CALL iom_put( "u_masstr"     , z3d )         ! mass transport in i-direction
310         CALL iom_put( "u_masstr_vint", z2d )         ! mass transport in i-direction vertical sum
311      ENDIF
312     
313      IF( iom_use("u_heattr") ) THEN
314         z2d(:,:) = 0._wp 
315         DO jk = 1, jpkm1
316            DO jj = 2, jpjm1
317               DO ji = fs_2, fs_jpim1   ! vector opt.
318                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
319               END DO
320            END DO
321         END DO
322         CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
323         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
324      ENDIF
325
326      IF( iom_use("u_salttr") ) THEN
327         z2d(:,:) = 0.e0 
328         DO jk = 1, jpkm1
329            DO jj = 2, jpjm1
330               DO ji = fs_2, fs_jpim1   ! vector opt.
331                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
332               END DO
333            END DO
334         END DO
335         CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
336         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
337      ENDIF
338
339     
340      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
341         z3d(:,:,jpk) = 0.e0
342         DO jk = 1, jpkm1
343            z3d(:,:,jk) = rau0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk)
344         END DO
345         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction
346      ENDIF
347     
348      IF( iom_use("v_heattr") ) THEN
349         z2d(:,:) = 0.e0 
350         DO jk = 1, jpkm1
351            DO jj = 2, jpjm1
352               DO ji = fs_2, fs_jpim1   ! vector opt.
353                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
354               END DO
355            END DO
356         END DO
357         CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
358         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
359      ENDIF
360
361      IF( iom_use("v_salttr") ) THEN
362         z2d(:,:) = 0._wp 
363         DO jk = 1, jpkm1
364            DO jj = 2, jpjm1
365               DO ji = fs_2, fs_jpim1   ! vector opt.
366                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
367               END DO
368            END DO
369         END DO
370         CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
371         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
372      ENDIF
373
374      IF( iom_use("tosmint") ) THEN
375         z2d(:,:) = 0._wp
376         DO jk = 1, jpkm1
377            DO jj = 2, jpjm1
378               DO ji = fs_2, fs_jpim1   ! vector opt.
379                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm)
380               END DO
381            END DO
382         END DO
383         CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
384         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature
385      ENDIF
386      IF( iom_use("somint") ) THEN
387         z2d(:,:)=0._wp
388         DO jk = 1, jpkm1
389            DO jj = 2, jpjm1
390               DO ji = fs_2, fs_jpim1   ! vector opt.
391                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
392               END DO
393            END DO
394         END DO
395         CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
396         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity
397      ENDIF
398
399      CALL iom_put( "bn2", rn2 )                      ! Brunt-Vaisala buoyancy frequency (N^2)
400      !
401
402      IF (ln_diatmb)   CALL dia_tmb( Kmm )            ! tmb values
403         
404      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging
405
406      IF( ln_timing )   CALL timing_stop('dia_wri')
407      !
408   END SUBROUTINE dia_wri
409
410#else
411   !!----------------------------------------------------------------------
412   !!   Default option                                  use IOIPSL  library
413   !!----------------------------------------------------------------------
414
415   INTEGER FUNCTION dia_wri_alloc()
416      !!----------------------------------------------------------------------
417      INTEGER, DIMENSION(2) :: ierr
418      !!----------------------------------------------------------------------
419      ierr = 0
420      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
421         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
422         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
423         !
424     dia_wri_alloc = MAXVAL(ierr)
425      CALL mpp_sum( 'diawri', dia_wri_alloc )
426      !
427   END FUNCTION dia_wri_alloc
428 
429   INTEGER FUNCTION dia_wri_alloc_abl()
430      !!----------------------------------------------------------------------
431     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
432      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
433      !
434   END FUNCTION dia_wri_alloc_abl
435
436   
437   SUBROUTINE dia_wri( kt, Kmm )
438      !!---------------------------------------------------------------------
439      !!                  ***  ROUTINE dia_wri  ***
440      !!                   
441      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
442      !!      NETCDF format is used by default
443      !!
444      !! ** Method  :   At the beginning of the first time step (nit000),
445      !!      define all the NETCDF files and fields
446      !!      At each time step call histdef to compute the mean if ncessary
447      !!      Each nn_write time step, output the instantaneous or mean fields
448      !!----------------------------------------------------------------------
449      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
450      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
451      !
452      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
453      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
454      INTEGER  ::   inum = 11                                ! temporary logical unit
455      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
456      INTEGER  ::   ierr                                     ! error code return from allocation
457      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
458      INTEGER  ::   ipka                                     ! ABL
459      INTEGER  ::   jn, ierror                               ! local integers
460      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
461      !
462      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
463      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
464      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
465      !!----------------------------------------------------------------------
466      !
467      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==!
468         CALL dia_wri_state( Kmm, 'output.init' )
469         ninist = 0
470      ENDIF
471      !
472      IF( nn_write == -1 )   RETURN   ! we will never do any output
473      !
474      IF( ln_timing )   CALL timing_start('dia_wri')
475      !
476      ! 0. Initialisation
477      ! -----------------
478
479      ll_print = .FALSE.                  ! local variable for debugging
480      ll_print = ll_print .AND. lwp
481
482      ! Define frequency of output and means
483      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
484#if defined key_diainstant
485      zsto = nn_write * rdt
486      clop = "inst("//TRIM(clop)//")"
487#else
488      zsto=rdt
489      clop = "ave("//TRIM(clop)//")"
490#endif
491      zout = nn_write * rdt
492      zmax = ( nitend - nit000 + 1 ) * rdt
493
494      ! Define indices of the horizontal output zoom and vertical limit storage
495      iimi = 1      ;      iima = jpi
496      ijmi = 1      ;      ijma = jpj
497      ipk = jpk
498      IF(ln_abl) ipka = jpkam1
499
500      ! define time axis
501      it = kt
502      itmod = kt - nit000 + 1
503
504
505      ! 1. Define NETCDF files and fields at beginning of first time step
506      ! -----------------------------------------------------------------
507
508      IF( kt == nit000 ) THEN
509
510         ! Define the NETCDF files (one per grid)
511
512         ! Compute julian date from starting date of the run
513         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
514         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
515         IF(lwp)WRITE(numout,*)
516         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
517            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
518         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
519                                 ' limit storage in depth = ', ipk
520
521         ! WRITE root name in date.file for use by postpro
522         IF(lwp) THEN
523            CALL dia_nam( clhstnam, nn_write,' ' )
524            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
525            WRITE(inum,*) clhstnam
526            CLOSE(inum)
527         ENDIF
528
529         ! Define the T grid FILE ( nid_T )
530
531         CALL dia_nam( clhstnam, nn_write, 'grid_T' )
532         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
533         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
534            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
535            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
536         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
537            &           "m", ipk, gdept_1d, nz_T, "down" )
538         !                                                            ! Index of ocean points
539         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
540         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
541         !
542         IF( ln_icebergs ) THEN
543            !
544            !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after
545            !! that routine is called from nemogcm, so do it here immediately before its needed
546            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror )
547            CALL mpp_sum( 'diawri', ierror )
548            IF( ierror /= 0 ) THEN
549               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array')
550               RETURN
551            ENDIF
552            !
553            !! iceberg vertical coordinate is class number
554            CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class
555               &           "number", nclasses, class_num, nb_T )
556            !
557            !! each class just needs the surface index pattern
558            ndim_bT = 3
559            DO jn = 1,nclasses
560               ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj)
561            ENDDO
562            !
563         ENDIF
564
565         ! Define the U grid FILE ( nid_U )
566
567         CALL dia_nam( clhstnam, nn_write, 'grid_U' )
568         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
569         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
570            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
571            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
572         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
573            &           "m", ipk, gdept_1d, nz_U, "down" )
574         !                                                            ! Index of ocean points
575         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
576         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
577
578         ! Define the V grid FILE ( nid_V )
579
580         CALL dia_nam( clhstnam, nn_write, 'grid_V' )                   ! filename
581         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
582         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
583            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
584            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
585         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
586            &          "m", ipk, gdept_1d, nz_V, "down" )
587         !                                                            ! Index of ocean points
588         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
589         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
590
591         ! Define the W grid FILE ( nid_W )
592
593         CALL dia_nam( clhstnam, nn_write, 'grid_W' )                   ! filename
594         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
595         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
596            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
597            &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
598         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
599            &          "m", ipk, gdepw_1d, nz_W, "down" )
600
601         IF( ln_abl ) THEN 
602         ! Define the ABL grid FILE ( nid_A )
603            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
604            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
605            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
606               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
607               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
608            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
609               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
610            !                                                            ! Index of ocean points
611         ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
612         zw3d_abl(:,:,:) = 1._wp 
613         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
614            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
615         DEALLOCATE(zw3d_abl)
616         ENDIF
617
618         ! Declare all the output fields as NETCDF variables
619
620         !                                                                                      !!! nid_T : 3D
621         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
622            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
623         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
624            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
625         IF(  .NOT.ln_linssh  ) THEN
626            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t(:,:,:,Kmm)
627            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
628            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t(:,:,:,Kmm)
629            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
630            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t(:,:,:,Kmm)
631            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
632         ENDIF
633         !                                                                                      !!! nid_T : 2D
634         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
635            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
636         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
637            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
638         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
639            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
640         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
641            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
642         CALL histdef( nid_T, "sorunoff", "River runoffs"                      , "Kg/m2/s",   &  ! runoffs
643            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
644         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx
645            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
646         IF(  ln_linssh  ) THEN
647            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * ts(:,:,1,jp_tem,Kmm)
648            &                                                                  , "KgC/m2/s",  &  ! sosst_cd
649            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
650            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * ts(:,:,1,jp_sal,Kmm)
651            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd
652            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
653         ENDIF
654         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
655            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
656         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
657            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
658         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
659            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
660         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
661            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
662         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
663            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
664         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
665            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
666         !
667         IF( ln_abl ) THEN
668            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
669               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
670            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
671               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
672            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
673               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
674            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
675               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
676            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
677               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
678            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
679               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
680            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
681               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
682            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
683               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                 
684#if defined key_si3
685            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
686               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
687#endif
688            CALL histend( nid_A, snc4chunks=snc4set )
689         ENDIF
690         !
691         IF( ln_icebergs ) THEN
692            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
693               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
694            CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , &
695               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
696            CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", &
697               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
698            CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , &
699               &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
700            IF( ln_bergdia ) THEN
701               CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", &
702                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
703               CALL histdef( nid_T, "berg_buoy_melt"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", &
704                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
705               CALL histdef( nid_T, "berg_eros_melt"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", &
706                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
707               CALL histdef( nid_T, "berg_conv_melt"      , "Convective component of iceberg melt rate", "kg/m2/s", &
708                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
709               CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , &
710                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
711               CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", &
712                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
713               CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", &
714                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
715               CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , &
716                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
717               CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , &
718                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
719               CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , &
720                  &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
721            ENDIF
722         ENDIF
723
724         IF( ln_ssr ) THEN
725            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
726               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
727            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
728               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
729            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn
730               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
731         ENDIF
732       
733         clmx ="l_max(only(x))"    ! max index on a period
734!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX
735!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
736#if defined key_diahth
737         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
738            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
739         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
740            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
741         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
742            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
743         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "J/m2"   ,   & ! htc3
744            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
745#endif
746
747         CALL histend( nid_T, snc4chunks=snc4set )
748
749         !                                                                                      !!! nid_U : 3D
750         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! uu(:,:,:,Kmm)
751            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
752         IF( ln_wave .AND. ln_sdw) THEN
753            CALL histdef( nid_U, "sdzocrtx", "Stokes Drift Zonal Current"         , "m/s"    ,   &  ! usd
754               &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
755         ENDIF
756         !                                                                                      !!! nid_U : 2D
757         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
758            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
759
760         CALL histend( nid_U, snc4chunks=snc4set )
761
762         !                                                                                      !!! nid_V : 3D
763         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vv(:,:,:,Kmm)
764            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
765         IF( ln_wave .AND. ln_sdw) THEN
766            CALL histdef( nid_V, "sdmecrty", "Stokes Drift Meridional Current"    , "m/s"    ,   &  ! vsd
767               &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
768         ENDIF
769         !                                                                                      !!! nid_V : 2D
770         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
771            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
772
773         CALL histend( nid_V, snc4chunks=snc4set )
774
775         !                                                                                      !!! nid_W : 3D
776         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! ww
777            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
778         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
779            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
780         CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avm
781            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
782
783         IF( ln_zdfddm ) THEN
784            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
785               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
786         ENDIF
787         
788         IF( ln_wave .AND. ln_sdw) THEN
789            CALL histdef( nid_W, "sdvecrtz", "Stokes Drift Vertical Current"   , "m/s"    ,   &  ! wsd
790               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
791         ENDIF
792         !                                                                                      !!! nid_W : 2D
793         CALL histend( nid_W, snc4chunks=snc4set )
794
795         IF(lwp) WRITE(numout,*)
796         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
797         IF(ll_print) CALL FLUSH(numout )
798
799      ENDIF
800
801      ! 2. Start writing data
802      ! ---------------------
803
804      ! ndex(1) est utilise ssi l'avant dernier argument est different de
805      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
806      ! donne le nombre d'elements, et ndex la liste des indices a sortir
807
808      IF( lwp .AND. MOD( itmod, nn_write ) == 0 ) THEN
809         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
810         WRITE(numout,*) '~~~~~~ '
811      ENDIF
812
813      IF( .NOT.ln_linssh ) THEN
814         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! heat content
815         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T  )   ! salt content
816         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface heat content
817         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity content
818      ELSE
819         CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T  )   ! temperature
820         CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T  )   ! salinity
821         CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT )   ! sea surface temperature
822         CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT )   ! sea surface salinity
823      ENDIF
824      IF( .NOT.ln_linssh ) THEN
825         zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
826         CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm) , ndim_T , ndex_T  )   ! level thickness
827         CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T  )   ! t-point depth
828         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
829      ENDIF
830      CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm)          , ndim_hT, ndex_hT )   ! sea surface height
831      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
832      CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs
833      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux
834                                                                                  ! (includes virtual salt flux beneath ice
835                                                                                  ! in linear free surface case)
836      IF( ln_linssh ) THEN
837         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm)
838         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
839         zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm)
840         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss
841      ENDIF
842      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
843      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
844      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
845      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
846      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
847      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
848      !
849      IF( ln_abl ) THEN
850         ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
851         IF( ln_mskland )   THEN
852            DO jk=1,jpka
853               zw3d_abl(:,:,jk) = tmask(:,:,1)
854            END DO       
855         ELSE
856            zw3d_abl(:,:,:) = 1._wp     
857         ENDIF       
858         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh
859         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
860         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
861         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
862         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl       
863         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
864         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
865         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl
866#if defined key_si3
867         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
868#endif
869         DEALLOCATE(zw3d_abl)
870      ENDIF
871      !
872      IF( ln_icebergs ) THEN
873         !
874         CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT ) 
875         CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )         
876         CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT ) 
877         !
878         CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT )
879         !
880         IF( ln_bergdia ) THEN
881            CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   ) 
882            CALL histwrite( nid_T, "berg_buoy_melt"      , it, buoy_melt        , ndim_hT, ndex_hT   ) 
883            CALL histwrite( nid_T, "berg_eros_melt"      , it, eros_melt        , ndim_hT, ndex_hT   ) 
884            CALL histwrite( nid_T, "berg_conv_melt"      , it, conv_melt        , ndim_hT, ndex_hT   ) 
885            CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   ) 
886            CALL histwrite( nid_T, "bits_src"            , it, bits_src         , ndim_hT, ndex_hT   ) 
887            CALL histwrite( nid_T, "bits_melt"           , it, bits_melt        , ndim_hT, ndex_hT   ) 
888            CALL histwrite( nid_T, "bits_mass"           , it, bits_mass        , ndim_hT, ndex_hT   ) 
889            CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   ) 
890            !
891            CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   )
892         ENDIF
893      ENDIF
894
895      IF( ln_ssr ) THEN
896         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
897         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
898         zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1)
899         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
900      ENDIF
901!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
902!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
903
904#if defined key_diahth
905      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
906      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
907      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
908      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
909#endif
910
911      CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm)            , ndim_U , ndex_U )    ! i-current
912      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
913
914      CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm)            , ndim_V , ndex_V  )   ! j-current
915      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
916
917      IF( ln_zad_Aimp ) THEN
918         CALL histwrite( nid_W, "vovecrtz", it, ww + wi     , ndim_T, ndex_T )    ! vert. current
919      ELSE
920         CALL histwrite( nid_W, "vovecrtz", it, ww          , ndim_T, ndex_T )    ! vert. current
921      ENDIF
922      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
923      CALL histwrite( nid_W, "votkeavm", it, avm            , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
924      IF( ln_zdfddm ) THEN
925         CALL histwrite( nid_W, "voddmavs", it, avs         , ndim_T, ndex_T )    ! S vert. eddy diff. coef.
926      ENDIF
927
928      IF( ln_wave .AND. ln_sdw ) THEN
929         CALL histwrite( nid_U, "sdzocrtx", it, usd         , ndim_U , ndex_U )    ! i-StokesDrift-current
930         CALL histwrite( nid_V, "sdmecrty", it, vsd         , ndim_V , ndex_V )    ! j-StokesDrift-current
931         CALL histwrite( nid_W, "sdvecrtz", it, wsd         , ndim_T , ndex_T )    ! StokesDrift vert. current
932      ENDIF
933
934      ! 3. Close all files
935      ! ---------------------------------------
936      IF( kt == nitend ) THEN
937         CALL histclo( nid_T )
938         CALL histclo( nid_U )
939         CALL histclo( nid_V )
940         CALL histclo( nid_W )
941         IF(ln_abl) CALL histclo( nid_A )
942      ENDIF
943      !
944      IF( ln_timing )   CALL timing_stop('dia_wri')
945      !
946   END SUBROUTINE dia_wri
947#endif
948
949   SUBROUTINE dia_wri_state( Kmm, cdfile_name )
950      !!---------------------------------------------------------------------
951      !!                 ***  ROUTINE dia_wri_state  ***
952      !!       
953      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
954      !!      the instantaneous ocean state and forcing fields.
955      !!        Used to find errors in the initial state or save the last
956      !!      ocean state in case of abnormal end of a simulation
957      !!
958      !! ** Method  :   NetCDF files using ioipsl
959      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
960      !!      File 'output.abort.nc' is created in case of abnormal job end
961      !!----------------------------------------------------------------------
962      INTEGER           , INTENT( in ) ::   Kmm              ! time level index
963      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
964      !!
965      INTEGER :: inum, jk
966      !!----------------------------------------------------------------------
967      !
968      IF(lwp) WRITE(numout,*)
969      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
970      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
971      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
972
973#if defined key_si3
974     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
975#else
976     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
977#endif
978
979      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature
980      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity
981      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height
982      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
983      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
984      IF( ln_zad_Aimp ) THEN
985         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity
986      ELSE
987         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
988      ENDIF
989      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity
990      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height
991
992      IF ( ln_isf ) THEN
993         IF (ln_isfcav_mlt) THEN
994            CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav          )    ! now k-velocity
995            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity
996            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity
997            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,8)    )    ! now k-velocity
998            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,8)    )    ! now k-velocity
999            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,8), ktype = jp_i1 )
1000         END IF
1001         IF (ln_isfpar_mlt) THEN
1002            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,8)  )    ! now k-velocity
1003            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity
1004            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity
1005            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity
1006            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,8)    )    ! now k-velocity
1007            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,8)    )    ! now k-velocity
1008            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,8), ktype = jp_i1 )
1009         END IF
1010      END IF
1011
1012      IF( ALLOCATED(ahtu) ) THEN
1013         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point
1014         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point
1015      ENDIF
1016      IF( ALLOCATED(ahmt) ) THEN
1017         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point
1018         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point
1019      ENDIF
1020      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
1021      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
1022      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
1023      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
1024      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
1025      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
1026      IF(  .NOT.ln_linssh  ) THEN             
1027         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth
1028         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)          )    !  T-cell thickness 
1029      END IF
1030      IF( ln_wave .AND. ln_sdw ) THEN
1031         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity
1032         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity
1033         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity
1034      ENDIF
1035      IF ( ln_abl ) THEN
1036         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind
1037         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind
1038         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature
1039         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity
1040      ENDIF
1041 
1042#if defined key_si3
1043      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
1044         CALL ice_wri_state( inum )
1045      ENDIF
1046#endif
1047      !
1048      CALL iom_close( inum )
1049      !
1050   END SUBROUTINE dia_wri_state
1051
1052   !!======================================================================
1053END MODULE diawri
Note: See TracBrowser for help on using the repository browser.