source: NEMO/trunk/src/SAS/diawri.F90 @ 12633

Last change on this file since 12633 was 12633, checked in by smasson, 8 months ago

trunk: compile SAS without key_iomput, see #2426

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