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_r11265_ASINTER-01_Guillaume_ABL1D/src/SAS – NEMO

source: NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/SAS/diawri.F90 @ 11357

Last change on this file since 11357 was 11357, checked in by gsamson, 5 years ago

dev_r11265_ABL : ABL compatibility with SAS (no diff with blk when using ABL src or not in ORCA2_SAS_ICE cfg), see #2131
  • Property svn:keywords set to Id
File size: 24.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   !!----------------------------------------------------------------------
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 nwrite 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      IF( ln_timing )   CALL timing_start('dia_wri')
156      !
157      ! Output the initial state and forcings
158      IF( ninist == 1 ) THEN                       
159         CALL dia_wri_state( 'output.init' )
160         ninist = 0
161      ENDIF
162      !
163      ! 0. Initialisation
164      ! -----------------
165
166      ! local variable for debugging
167      ll_print = .FALSE.
168      ll_print = ll_print .AND. lwp
169
170      ! Define frequency of output and means
171      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
172      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
173      ENDIF
174#if defined key_diainstant
175      zsto = nwrite * rdt
176      clop = "inst("//TRIM(clop)//")"
177#else
178      zsto=rdt
179      clop = "ave("//TRIM(clop)//")"
180#endif
181      zout = nwrite * rdt
182      zmax = ( nitend - nit000 + 1 ) * rdt
183
184      ! Define indices of the horizontal output zoom and vertical limit storage
185      iimi = 1      ;      iima = jpi
186      ijmi = 1      ;      ijma = jpj
187      ipk = jpk
188     IF(ln_abl) ipka = jpkam1
189
190      ! define time axis
191      it = kt
192      itmod = kt - nit000 + 1
193
194
195      ! 1. Define NETCDF files and fields at beginning of first time step
196      ! -----------------------------------------------------------------
197
198      IF( kt == nit000 ) THEN
199
200         ! Define the NETCDF files (one per grid)
201
202         ! Compute julian date from starting date of the run
203         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
204         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
205         IF(lwp)WRITE(numout,*)
206         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
207            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
208         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
209                                 ' limit storage in depth = ', ipk
210
211         ! WRITE root name in date.file for use by postpro
212         IF(lwp) THEN
213            CALL dia_nam( clhstnam, nwrite,' ' )
214            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
215            WRITE(inum,*) clhstnam
216            CLOSE(inum)
217         ENDIF
218
219         ! Define the T grid FILE ( nid_T )
220
221         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
222         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
223         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
224            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
225            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
226         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
227            &           "m", ipk, gdept_1d, nz_T, "down" )
228         !                                                            ! Index of ocean points
229         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
230
231         ! Define the U grid FILE ( nid_U )
232
233         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
234         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
235         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
236            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
237            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
238         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
239            &           "m", ipk, gdept_1d, nz_U, "down" )
240         !                                                            ! Index of ocean points
241         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
242
243         ! Define the V grid FILE ( nid_V )
244
245         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
246         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
247         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
248            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
249            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
250         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
251            &          "m", ipk, gdept_1d, nz_V, "down" )
252         !                                                            ! Index of ocean points
253         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
254
255         ! No W grid FILE
256         IF( ln_abl ) THEN 
257         ! Define the ABL grid FILE ( nid_A )
258            CALL dia_nam( clhstnam, nwrite, 'grid_ABL' )
259            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
260            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
261               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
262               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
263            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
264               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
265            !                                                            ! Index of ocean points
266         ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
267         zw3d_abl(:,:,:) = 1._wp 
268         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
269            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
270         DEALLOCATE(zw3d_abl)
271         ENDIF
272
273         ! Declare all the output fields as NETCDF variables
274
275         !                                                                                      !!! nid_T : 3D
276         CALL histdef( nid_T, "sst_m", "Sea Surface temperature"            , "C"      ,   &  ! sst
277            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
278         CALL histdef( nid_T, "sss_m", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
279            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
280         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
281            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
282         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! (sfx)
283             &         jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
284         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
285            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
286         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
287            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
288         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
289            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
290         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
291            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
292!
293         IF( ln_abl ) THEN
294         !                                                                                      !!! nid_A : 3D
295         CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
296               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
297            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
298               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
299            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
300               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
301            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
302               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
303            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
304               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
305            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
306               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
307            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
308               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
309            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
310               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                 
311#if defined key_si3
312            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
313               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
314#endif
315          CALL histend( nid_A, snc4chunks=snc4set )
316       !
317       ENDIF
318!
319
320         CALL histend( nid_T, snc4chunks=snc4set )
321
322         !                                                                                      !!! nid_U : 3D
323         CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s"   ,         &  ! ssu
324            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
325         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
326            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
327
328         CALL histend( nid_U, snc4chunks=snc4set )
329
330         !                                                                                      !!! nid_V : 3D
331         CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s",            &  ! ssv_m
332            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
333         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
334            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
335
336         CALL histend( nid_V, snc4chunks=snc4set )
337
338         IF(lwp) WRITE(numout,*)
339         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
340         IF(ll_print) CALL FLUSH(numout )
341
342      ENDIF
343
344      ! 2. Start writing data
345      ! ---------------------
346
347      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
348      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
349      ! donne le nombre d'elements, et ndex la liste des indices a sortir
350
351      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
352         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
353         WRITE(numout,*) '~~~~~~ '
354      ENDIF
355
356      ! Write fields on T grid
357      CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT )   ! sea surface temperature
358      CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT )   ! sea surface salinity
359      CALL histwrite( nid_T, "sowaflup", it, (emp - rnf )  , ndim_hT, ndex_hT )   ! upward water flux
360      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux
361                                                                                  ! (includes virtual salt flux beneath ice
362                                                                                  ! in linear free surface case)
363
364      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
365      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
366      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
367      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
368!
369      IF( ln_abl ) THEN
370        ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
371        IF( ln_mskland )   THEN
372          DO jk=1,jpka
373             zw3d_abl(:,:,jk) = tmask(:,:,1)
374            END DO
375       ELSE
376            zw3d_abl(:,:,:) = 1._wp     
377         ENDIF       
378       CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh
379        CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
380        CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
381        CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
382        CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl     
383        CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
384        CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
385        CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl 
386#if defined key_si3
387         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
388#endif
389       DEALLOCATE(zw3d_abl)
390     ENDIF
391!
392
393         ! Write fields on U grid
394      CALL histwrite( nid_U, "ssu_m"   , it, ssu_m         , ndim_hU, ndex_hU )   ! i-current speed
395      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
396
397         ! Write fields on V grid
398      CALL histwrite( nid_V, "ssv_m"   , it, ssv_m         , ndim_hV, ndex_hV )   ! j-current speed
399      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
400
401      ! 3. Close all files
402      ! ---------------------------------------
403      IF( kt == nitend ) THEN
404         CALL histclo( nid_T )
405         CALL histclo( nid_U )
406         CALL histclo( nid_V )
407         IF(ln_abl) CALL histclo( nid_A )
408      ENDIF
409      !
410      IF( ln_timing )   CALL timing_stop('dia_wri')
411      !
412   END SUBROUTINE dia_wri
413#endif
414
415   SUBROUTINE dia_wri_state( cdfile_name )
416      !!---------------------------------------------------------------------
417      !!                 ***  ROUTINE dia_wri_state  ***
418      !!       
419      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
420      !!      the instantaneous ocean state and forcing fields.
421      !!        Used to find errors in the initial state or save the last
422      !!      ocean state in case of abnormal end of a simulation
423      !!
424      !! ** Method  :   NetCDF files using ioipsl
425      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
426      !!      File 'output.abort.nc' is created in case of abnormal job end
427      !!----------------------------------------------------------------------
428      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
429      !!
430      INTEGER :: inum
431      !!----------------------------------------------------------------------
432      !
433      IF(lwp) WRITE(numout,*)
434      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
435      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
436      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc'
437
438#if defined key_si3
439     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
440#else
441     CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
442#endif
443
444      CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature
445      CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity
446      CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height
447      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity
448      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity
449      CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity
450      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget
451      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux
452      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux
453      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction
454      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress
455      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress
456 
457#if defined key_si3
458      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid
459         CALL ice_wri_state( inum )
460      ENDIF
461#endif
462      !
463      CALL iom_close( inum )
464      !
465   END SUBROUTINE dia_wri_state
466
467   !!======================================================================
468END MODULE diawri
Note: See TracBrowser for help on using the repository browser.