source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/SAS/diawri.F90 @ 12154

Last change on this file since 12154 was 12154, checked in by cetlod, 10 months ago

commit

  • Property svn:keywords set to Id
File size: 24.1 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   !! * Substitutions
67#  include "vectopt_loop_substitute.h90"
68   !!----------------------------------------------------------------------
69   !! NEMO/SAS 4.0 , NEMO Consortium (2018)
70   !! $Id$
71   !! Software governed by the CeCILL license (see ./LICENSE)
72   !!----------------------------------------------------------------------
73CONTAINS
74
75# if defined key_iomput
76   !!----------------------------------------------------------------------
77   !!   'key_iomput'                                        use IOM library
78   !!----------------------------------------------------------------------
79   INTEGER FUNCTION dia_wri_alloc()
80      !
81      dia_wri_alloc = 0
82      !
83   END FUNCTION dia_wri_alloc
84
85   
86   SUBROUTINE dia_wri( kt )
87      !!---------------------------------------------------------------------
88      !!                  ***  ROUTINE dia_wri  ***
89      !!                   
90      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
91      !!      NETCDF format is used by default
92      !!      Standalone surface scheme
93      !!
94      !! ** Method  :  use iom_put
95      !!----------------------------------------------------------------------
96      !!
97      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
98      !!----------------------------------------------------------------------
99      !
100      ! Output the initial state and forcings
101      IF( ninist == 1 ) THEN
102         CALL dia_wri_state( 'output.init' )
103         ninist = 0
104      ENDIF
105      !
106   END SUBROUTINE dia_wri
107
108#else
109   !!----------------------------------------------------------------------
110   !!   Default option                                  use IOIPSL  library
111   !!----------------------------------------------------------------------
112   INTEGER FUNCTION dia_wri_alloc()
113      !!----------------------------------------------------------------------
114      INTEGER :: ierr
115      !!----------------------------------------------------------------------
116      !
117      ALLOCATE( ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc )
118      CALL mpp_sum( 'diawri', dia_wri_alloc )
119      !
120   END FUNCTION dia_wri_alloc
121   
122   INTEGER FUNCTION dia_wri_alloc_abl()
123      !!----------------------------------------------------------------------
124     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
125      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
126      !
127   END FUNCTION dia_wri_alloc_abl
128 
129   SUBROUTINE dia_wri( kt )
130      !!---------------------------------------------------------------------
131      !!                  ***  ROUTINE dia_wri  ***
132      !!                   
133      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
134      !!      NETCDF format is used by default
135      !!
136      !! ** Method  :   At the beginning of the first time step (nit000),
137      !!      define all the NETCDF files and fields
138      !!      At each time step call histdef to compute the mean if ncessary
139      !!      Each nn_write time step, output the instantaneous or mean fields
140      !!----------------------------------------------------------------------
141      !!
142      INTEGER, INTENT( in ) ::   kt      ! ocean time-step 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( '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 * rdt
178      clop = "inst("//TRIM(clop)//")"
179#else
180      zsto=rdt
181      clop = "ave("//TRIM(clop)//")"
182#endif
183      zout = nn_write * rdt
184      zmax = ( nitend - nit000 + 1 ) * rdt
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, rdt, 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, rdt, 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, rdt, 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, rdt, 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, nwrite, '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, rdt, 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( 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      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
431      !!
432      INTEGER :: inum
433      !!----------------------------------------------------------------------
434      !
435      IF(lwp) WRITE(numout,*)
436      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
437      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
438      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
439
440#if defined key_si3
441     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
442#else
443     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
444#endif
445
446      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature
447      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity
448      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height
449      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity
450      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity
451      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity
452      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
453      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
454      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
455      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
456      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
457      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
458 
459#if defined key_si3
460      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
461         CALL ice_wri_state( inum )
462      ENDIF
463#endif
464      !
465      CALL iom_close( inum )
466      !
467   END SUBROUTINE dia_wri_state
468
469   !!======================================================================
470END MODULE diawri
Note: See TracBrowser for help on using the repository browser.