source: NEMO/trunk/tests/BENCH/MY_SRC/diawri.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

File size: 22.0 KB
Line 
1MODULE diawri
2   !!======================================================================
3   !!                     ***  MODULE  diawri  ***
4   !! Ocean diagnostics :  write ocean output files
5   !!=====================================================================
6   !! History :  OPA  ! 1991-03  (M.-A. Foujols)  Original code
7   !!            4.0  ! 1991-11  (G. Madec)
8   !!                 ! 1992-06  (M. Imbard)  correction restart file
9   !!                 ! 1992-07  (M. Imbard)  split into diawri and rstwri
10   !!                 ! 1993-03  (M. Imbard)  suppress writibm
11   !!                 ! 1998-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
12   !!                 ! 1999-02  (E. Guilyardi)  name of netCDF files + variables
13   !!            8.2  ! 2000-06  (M. Imbard)  Original code (diabort.F)
14   !!   NEMO     1.0  ! 2002-06  (A.Bozec, E. Durand)  Original code (diainit.F)
15   !!             -   ! 2002-09  (G. Madec)  F90: Free form and module
16   !!             -   ! 2002-12  (G. Madec)  merge of diabort and diainit, F90
17   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
18   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
19   !!            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 dom_oce        ! ocean space and time domain
29   USE phycst         ! physical constants
30   USE dianam         ! build name of file (routine)
31   USE diahth         ! thermocline diagnostics
32   USE dynadv   , ONLY: ln_dynadv_vec
33   USE icb_oce        ! Icebergs
34   USE icbdia         ! Iceberg budgets
35   USE ldftra         ! lateral physics: eddy diffusivity coef.
36   USE ldfdyn         ! lateral physics: eddy viscosity   coef.
37   USE sbc_oce        ! Surface boundary condition: ocean fields
38   USE sbc_ice        ! Surface boundary condition: ice fields
39   USE sbcssr         ! restoring term toward SST/SSS climatology
40   USE sbcwave        ! wave parameters
41   USE wet_dry        ! wetting and drying
42   USE zdf_oce        ! ocean vertical physics
43   USE zdfdrg         ! ocean vertical physics: top/bottom friction
44   USE zdfmxl         ! mixed layer
45   !
46   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
47   USE in_out_manager ! I/O manager
48   USE diatmb         ! Top,middle,bottom output
49   USE dia25h         ! 25h Mean output
50   USE iom            !
51   USE ioipsl         !
52
53#if defined key_si3
54   USE ice 
55   USE icewri 
56#endif
57   USE lib_mpp         ! MPP library
58   USE timing          ! preformance summary
59   USE diu_bulk        ! diurnal warm layer
60   USE diu_coolskin    ! Cool skin
61
62   IMPLICIT NONE
63   PRIVATE
64
65   PUBLIC   dia_wri                 ! routines called by step.F90
66   PUBLIC   dia_wri_state
67   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
68
69   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
70   INTEGER ::          nb_T              , ndim_bT   ! grid_T file
71   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
72   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
73   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
74   INTEGER ::   ndex(1)                              ! ???
75   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
76   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
77   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
78
79   !!----------------------------------------------------------------------
80   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
81   !! $Id: diawri.F90 9598 2018-05-15 22:47:16Z nicolasmartin $
82   !! Software governed by the CeCILL licence     (./LICENSE)
83   !!----------------------------------------------------------------------
84CONTAINS
85
86#if defined key_iomput
87   !!----------------------------------------------------------------------
88   !!   'key_iomput'                                        use IOM library
89   !!----------------------------------------------------------------------
90   INTEGER FUNCTION dia_wri_alloc()
91      !
92      dia_wri_alloc = 0
93      !
94   END FUNCTION dia_wri_alloc
95
96   
97   SUBROUTINE dia_wri( kt, Kmm )
98      !!---------------------------------------------------------------------
99      !!                  ***  ROUTINE dia_wri  ***
100      !!                   
101      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
102      !!      NETCDF format is used by default
103      !!
104      !! ** Method  :  use iom_put
105      !!----------------------------------------------------------------------
106      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
107      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index
108      !!
109      INTEGER ::   ji, jj, jk       ! dummy loop indices
110      INTEGER ::   ikbot            ! local integer
111      REAL(wp)::   zztmp , zztmpx   ! local scalar
112      REAL(wp)::   zztmp2, zztmpy   !   -      -
113      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace
114      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace
115      !!----------------------------------------------------------------------
116      !
117      IF( ln_timing )   CALL timing_start('dia_wri')
118      !
119      ! Output the initial state and forcings
120      IF( ninist == 1 ) THEN                       
121         CALL dia_wri_state( Kmm, 'output.init' )
122         ninist = 0
123      ENDIF
124
125      ! Output of initial vertical scale factor
126      CALL iom_put("e3t_0", e3t_0(:,:,:) )
127      CALL iom_put("e3u_0", e3u_0(:,:,:) )
128      CALL iom_put("e3v_0", e3v_0(:,:,:) )
129      !
130      CALL iom_put( "e3t" , e3t(:,:,:,Kmm) )
131      CALL iom_put( "e3u" , e3u(:,:,:,Kmm) )
132      CALL iom_put( "e3v" , e3v(:,:,:,Kmm) )
133      CALL iom_put( "e3w" , e3w(:,:,:,Kmm) )
134      IF( iom_use("e3tdef") )   &
135         CALL iom_put( "e3tdef"  , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
136
137      IF( ll_wd ) THEN
138         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying)
139      ELSE
140         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height
141      ENDIF
142
143      IF( iom_use("wetdep") )   &                  ! wet depth
144         CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )
145     
146      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature
147      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature
148      IF ( iom_use("sbt") ) THEN
149         DO jj = 1, jpj
150            DO ji = 1, jpi
151               ikbot = mbkt(ji,jj)
152               z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
153            END DO
154         END DO
155         CALL iom_put( "sbt", z2d )                ! bottom temperature
156      ENDIF
157     
158      CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) )    ! 3D salinity
159      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity
160      IF ( iom_use("sbs") ) THEN
161         DO jj = 1, jpj
162            DO ji = 1, jpi
163               ikbot = mbkt(ji,jj)
164               z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
165            END DO
166         END DO
167         CALL iom_put( "sbs", z2d )                ! bottom salinity
168      ENDIF
169
170      IF ( iom_use("taubot") ) THEN                ! bottom stress
171         zztmp = rau0 * 0.25
172         z2d(:,:) = 0._wp
173         DO jj = 2, jpjm1
174            DO ji = fs_2, fs_jpim1   ! vector opt.
175               zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   &
176                  &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   &
177                  &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   &
178                  &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2
179               z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 
180               !
181            END DO
182         END DO
183         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
184         CALL iom_put( "taubot", z2d )           
185      ENDIF
186         
187      CALL iom_put( "uoce", uu(:,:,:,Kmm) )            ! 3D i-current
188      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current
189      IF ( iom_use("sbu") ) THEN
190         DO jj = 1, jpj
191            DO ji = 1, jpi
192               ikbot = mbku(ji,jj)
193               z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
194            END DO
195         END DO
196         CALL iom_put( "sbu", z2d )                ! bottom i-current
197      ENDIF
198     
199      CALL iom_put( "voce", vv(:,:,:,Kmm) )            ! 3D j-current
200      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current
201      IF ( iom_use("sbv") ) THEN
202         DO jj = 1, jpj
203            DO ji = 1, jpi
204               ikbot = mbkv(ji,jj)
205               z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
206            END DO
207         END DO
208         CALL iom_put( "sbv", z2d )                ! bottom j-current
209      ENDIF
210
211      IF( ln_zad_Aimp ) ww = ww + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
212      !
213      CALL iom_put( "woce", ww )                   ! vertical velocity
214      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
215         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
216         z2d(:,:) = rau0 * e1e2t(:,:)
217         DO jk = 1, jpk
218            z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:)
219         END DO
220         CALL iom_put( "w_masstr" , z3d ) 
221         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
222      ENDIF
223      !
224      IF( ln_zad_Aimp ) ww = ww - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output
225
226      CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef.
227      CALL iom_put( "avs" , avs )                  ! S vert. eddy diff. coef.
228      CALL iom_put( "avm" , avm )                  ! T vert. eddy visc. coef.
229
230      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) )
231      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
232
233      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
234         DO jj = 2, jpjm1                                    ! sst gradient
235            DO ji = fs_2, fs_jpim1   ! vector opt.
236               zztmp  = ts(ji,jj,1,jp_tem,Kmm)
237               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)
238               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)
239               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
240                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
241            END DO
242         END DO
243         CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
244         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient
245         z2d(:,:) = SQRT( z2d(:,:) )
246         CALL iom_put( "sstgrad" ,  z2d )          ! module of sst gradient
247      ENDIF
248         
249      ! heat and salt contents
250      IF( iom_use("heatc") ) THEN
251         z2d(:,:)  = 0._wp 
252         DO jk = 1, jpkm1
253            DO jj = 1, jpj
254               DO ji = 1, jpi
255                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
256               END DO
257            END DO
258         END DO
259         CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2)
260      ENDIF
261
262      IF( iom_use("saltc") ) THEN
263         z2d(:,:)  = 0._wp 
264         DO jk = 1, jpkm1
265            DO jj = 1, jpj
266               DO ji = 1, jpi
267                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
268               END DO
269            END DO
270         END DO
271         CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2)
272      ENDIF
273      !
274      IF ( iom_use("eken") ) THEN
275         z3d(:,:,jpk) = 0._wp 
276         DO jk = 1, jpkm1
277            DO jj = 2, jpjm1
278               DO ji = fs_2, fs_jpim1   ! vector opt.
279                  zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
280                  z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   &
281                     &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   &
282                     &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   &
283                     &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   )
284               END DO
285            END DO
286         END DO
287         CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
288         CALL iom_put( "eken", z3d )                 ! kinetic energy
289      ENDIF
290      !
291      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence
292      !
293      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
294         z3d(:,:,jpk) = 0.e0
295         z2d(:,:) = 0.e0
296         DO jk = 1, jpkm1
297            z3d(:,:,jk) = rau0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk)
298            z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
299         END DO
300         CALL iom_put( "u_masstr"     , z3d )         ! mass transport in i-direction
301         CALL iom_put( "u_masstr_vint", z2d )         ! mass transport in i-direction vertical sum
302      ENDIF
303     
304      IF( iom_use("u_heattr") ) THEN
305         z2d(:,:) = 0._wp 
306         DO jk = 1, jpkm1
307            DO jj = 2, jpjm1
308               DO ji = fs_2, fs_jpim1   ! vector opt.
309                  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) )
310               END DO
311            END DO
312         END DO
313         CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
314         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction
315      ENDIF
316
317      IF( iom_use("u_salttr") ) THEN
318         z2d(:,:) = 0.e0 
319         DO jk = 1, jpkm1
320            DO jj = 2, jpjm1
321               DO ji = fs_2, fs_jpim1   ! vector opt.
322                  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) )
323               END DO
324            END DO
325         END DO
326         CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
327         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction
328      ENDIF
329
330     
331      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
332         z3d(:,:,jpk) = 0.e0
333         DO jk = 1, jpkm1
334            z3d(:,:,jk) = rau0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk)
335         END DO
336         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction
337      ENDIF
338     
339      IF( iom_use("v_heattr") ) THEN
340         z2d(:,:) = 0.e0 
341         DO jk = 1, jpkm1
342            DO jj = 2, jpjm1
343               DO ji = fs_2, fs_jpim1   ! vector opt.
344                  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) )
345               END DO
346            END DO
347         END DO
348         CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
349         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction
350      ENDIF
351
352      IF( iom_use("v_salttr") ) THEN
353         z2d(:,:) = 0._wp 
354         DO jk = 1, jpkm1
355            DO jj = 2, jpjm1
356               DO ji = fs_2, fs_jpim1   ! vector opt.
357                  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) )
358               END DO
359            END DO
360         END DO
361         CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
362         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction
363      ENDIF
364
365      IF( iom_use("tosmint") ) THEN
366         z2d(:,:) = 0._wp
367         DO jk = 1, jpkm1
368            DO jj = 2, jpjm1
369               DO ji = fs_2, fs_jpim1   ! vector opt.
370                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm)
371               END DO
372            END DO
373         END DO
374         CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
375         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature
376      ENDIF
377      IF( iom_use("somint") ) THEN
378         z2d(:,:)=0._wp
379         DO jk = 1, jpkm1
380            DO jj = 2, jpjm1
381               DO ji = fs_2, fs_jpim1   ! vector opt.
382                  z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
383               END DO
384            END DO
385         END DO
386         CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
387         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity
388      ENDIF
389
390      CALL iom_put( "bn2", rn2 )                      ! Brunt-Vaisala buoyancy frequency (N^2)
391      !
392
393      IF (ln_diatmb)   CALL dia_tmb( Kmm )            ! tmb values
394         
395      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging
396
397      IF( ln_timing )   CALL timing_stop('dia_wri')
398      !
399   END SUBROUTINE dia_wri
400
401#else
402   !!----------------------------------------------------------------------
403   !!   Default option                                  use IOIPSL  library
404   !!----------------------------------------------------------------------
405
406   INTEGER FUNCTION dia_wri_alloc()
407      !
408      dia_wri_alloc = 0
409      !
410   END FUNCTION dia_wri_alloc
411
412   
413   SUBROUTINE dia_wri( kt, Kmm )
414
415      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
416      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index
417      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==!
418         CALL dia_wri_state( Kmm, 'output.init' )
419         ninist = 0
420      ENDIF
421      !
422      ! 0. Initialisation
423      ! -----------------
424
425   END SUBROUTINE dia_wri
426
427#endif
428
429   SUBROUTINE dia_wri_state( Kmm, cdfile_name )
430      !!---------------------------------------------------------------------
431      !!                 ***  ROUTINE dia_wri_state  ***
432      !!       
433      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
434      !!      the instantaneous ocean state and forcing fields.
435      !!        Used to find errors in the initial state or save the last
436      !!      ocean state in case of abnormal end of a simulation
437      !!
438      !! ** Method  :   NetCDF files using ioipsl
439      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
440      !!      File 'output.abort.nc' is created in case of abnormal job end
441      !!----------------------------------------------------------------------
442      INTEGER           , INTENT( in ) ::   Kmm              ! time level index
443      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
444      !!
445      INTEGER :: inum
446      !!----------------------------------------------------------------------
447      !
448      IF(lwp) WRITE(numout,*)
449      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
450      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
451      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
452
453#if defined key_si3
454     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
455#else
456     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
457#endif
458
459      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature
460      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity
461      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height
462      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity
463      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity
464      IF( ln_zad_Aimp ) THEN
465         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity
466      ELSE
467         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity
468      ENDIF
469      IF( ALLOCATED(ahtu) ) THEN
470         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point
471         CALL iom_rstput( 0, 0, inum,  'ahtv', ahtv              )    ! aht at v-point
472      ENDIF
473      IF( ALLOCATED(ahmt) ) THEN
474         CALL iom_rstput( 0, 0, inum,  'ahmt', ahmt              )    ! ahmt at u-point
475         CALL iom_rstput( 0, 0, inum,  'ahmf', ahmf              )    ! ahmf at v-point
476      ENDIF
477      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
478      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
479      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
480      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
481      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
482      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
483      IF(  .NOT.ln_linssh  ) THEN             
484         CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth
485         CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)          )    !  T-cell thickness 
486      END IF
487      IF( ln_wave .AND. ln_sdw ) THEN
488         CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd            )    ! now StokesDrift i-velocity
489         CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd            )    ! now StokesDrift j-velocity
490         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity
491      ENDIF
492 
493#if defined key_si3
494      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
495         CALL ice_wri_state( inum )
496      ENDIF
497#endif
498      !
499      CALL iom_close( inum )
500      !
501   END SUBROUTINE dia_wri_state
502
503   !!======================================================================
504END MODULE diawri
Note: See TracBrowser for help on using the repository browser.