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 trunk/NEMO/OPA_SRC/DIA – NEMO

source: trunk/NEMO/OPA_SRC/DIA/diawri.F90 @ 389

Last change on this file since 389 was 389, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

  • configuration parameters are just integer when agrif is used
  • add call to agrif routines with key_agrif
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 35.0 KB
Line 
1MODULE diawri
2   !!======================================================================
3   !!                     ***  MODULE  diawri  ***
4   !! Ocean diagnostics :  write ocean output files
5   !!=====================================================================
6
7   !!----------------------------------------------------------------------
8   !! * Modules used
9   USE oce             ! ocean dynamics and tracers
10   USE dom_oce         ! ocean space and time domain
11   USE zdf_oce         ! ocean vertical physics
12   USE ldftra_oce      ! ocean active tracers: lateral physics
13   USE ldfdyn_oce      ! ocean dynamics: lateral physics
14   USE sol_oce         ! solver variables
15   USE ice_oce         ! ice variables
16   USE phycst          ! physical constants
17   USE ocfzpt          ! ocean freezing point
18   USE ocesbc          ! surface thermohaline fluxes
19   USE taumod          ! surface stress
20   USE flxrnf          ! ocean runoffs
21   USE zdfmxl          ! mixed layer
22   USE daymod          ! calendar
23   USE dianam          ! build name of file (routine)
24   USE zdfddm          ! vertical  physics: double diffusion
25   USE diahth          ! thermocline diagnostics
26   USE diaspr          ! surface pressure diagnostics (rigid lid case)
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
28   USE in_out_manager  ! I/O manager
29   USE flx_oce         ! sea-ice/ocean forcings variables
30   USE diadimg         ! dimg direct access file format output
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Accessibility
36   PUBLIC dia_wri                 ! routines called by step.F90
37   PUBLIC dia_wri_state
38
39   !! * Module variables
40   INTEGER ::   &
41      nid_T, nz_T, nh_T, ndim_T, ndim_hT,      &   ! grid_T file
42      nid_U, nz_U, nh_U, ndim_U, ndim_hU,      &   ! grid_U file
43      nid_V, nz_V, nh_V, ndim_V, ndim_hV,      &   ! grid_V file
44      nid_W, nz_W, nh_W,                       &   ! grid_W file
45      ndex(1)                                      ! ???
46   INTEGER, DIMENSION(jpi*jpj) ::   &
47      ndex_hT, ndex_hU, ndex_hV
48   INTEGER, DIMENSION(jpi*jpj*jpk) ::   &
49      ndex_T, ndex_U, ndex_V
50
51   !! * Substitutions
52#  include "zdfddm_substitute.h90"
53   !!----------------------------------------------------------------------
54   !!   OPA 9.0 , LOCEAN-IPSL (2005)
55   !! $Header$
56   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
57   !!----------------------------------------------------------------------
58
59CONTAINS
60
61#if defined key_dimgout
62   !!----------------------------------------------------------------------
63   !!   dia_wri       : create the dimg direct access output file (mpp)
64   !!----------------------------------------------------------------------
65#   include "diawri_dimg.h90"
66
67#else
68   !!----------------------------------------------------------------------
69   !!   Default option                                   NetCDF output file
70   !!----------------------------------------------------------------------
71   !!   dia_wri       : create the standart NetCDF output files
72   !!   dia_wri_state : create an output NetCDF file for a single
73   !!                   instantaeous ocean state and forcing fields
74   !!----------------------------------------------------------------------
75
76   SUBROUTINE dia_wri( kt, kindic )
77      !!---------------------------------------------------------------------
78      !!                  ***  ROUTINE dia_wri  ***
79      !!                   
80      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
81      !!      NETCDF format is used by default
82      !!
83      !! ** Method  :   At the beginning of the first time step (nit000),
84      !!      define all the NETCDF files and fields
85      !!      At each time step call histdef to compute the mean if ncessary
86      !!      Each nwrite time step, output the instantaneous or mean fields
87      !!      IF kindic <0, output of fields before the model interruption.
88      !!      IF kindic =0, time step loop
89      !!      IF kindic >0, output of fields before the time step loop
90      !!
91      !! History :
92      !!        !  91-03  (M.-A. Foujols)  Original code
93      !!        !  91-11  (G. Madec)
94      !!        !  92-06  (M. Imbard)  correction restart file
95      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
96      !!        !  93-03  (M. Imbard)  suppress writibm
97      !!        !  98-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
98      !!        !  99-02  (E. Guilyardi)  name of netCDF files + variables
99      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
100      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
101      !!----------------------------------------------------------------------
102      !! * Modules used
103      USE ioipsl
104
105      !! * Arguments
106      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
107      INTEGER, INTENT( in ) ::   kindic  !
108
109      !! * Local declarations
110      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
111      CHARACTER (len=40) ::           &
112         clhstnam, clop, clmx            ! temporary names
113      INTEGER ::   inum = 11             ! temporary logical unit
114      INTEGER ::   &
115         iimi, iima, ipk, it,         &  ! temporary integers
116         ijmi, ijma                      !    "          "
117      REAL(wp) ::   &
118         zsto, zout, zmax,            &  ! temporary scalars
119         zjulian, zdt                    !    "         "
120      REAL(wp), DIMENSION(jpi,jpj) :: &
121         zw2d                            ! temporary workspace
122      CHARACTER (len=80) :: clname
123      !!----------------------------------------------------------------------
124     
125      ! 0. Initialisation
126      ! -----------------
127     
128      ! local variable for debugging
129      ll_print = .FALSE.
130      ll_print = ll_print .AND. lwp
131
132      ! Define frequency of output and means
133      zdt = rdt
134      IF( nacc == 1 ) zdt = rdtmin
135#if defined key_diainstant
136      zsto = nwrite * zdt
137      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
138      !!! clop="inst(only(x))"   ! put 1.e+20 on land (very expensive!!)
139#else
140      zsto=zdt
141      clop="ave(x)"              ! no use of the mask value (require less cpu time)
142      !!! clop="ave(only(x))"    ! put 1.e+20 on land (very expensive!!)
143#endif
144      zout = nwrite * zdt
145      zmax = ( nitend - nit000 + 1 ) * zdt
146
147      ! Define indices of the horizontal output zoom and vertical limit storage
148      iimi = 1      ;      iima = jpi
149      ijmi = 1      ;      ijma = jpj
150      ipk = jpk
151
152      ! define time axis
153      it = kt - nit000 + 1
154
155
156      ! 1. Define NETCDF files and fields at beginning of first time step
157      ! -----------------------------------------------------------------
158
159      IF(ll_print) WRITE(numout,*) 'dia_wri kt = ', kt, ' kindic ', kindic
160
161      IF( kt == nit000 ) THEN
162
163         ! Define the NETCDF files (one per grid)
164         
165         ! Compute julian date from starting date of the run
166         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
167         IF(lwp)WRITE(numout,*)
168         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
169            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
170         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
171                                 ' limit storage in depth = ', ipk
172
173         ! WRITE root name in date.file for use by postpro
174         CALL dia_nam( clhstnam, nwrite,' ' )
175         clname = 'date.file'
176         CALL ctlopn( inum, clname,  'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
177         WRITE(inum,*) clhstnam
178         CLOSE(inum)
179         
180         ! Define the T grid FILE ( nid_T )
181         
182         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
183         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
184         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
185            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
186            &          0, zjulian, zdt, nh_T, nid_T, domain_id=nidom )
187         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
188            &           "m", ipk, gdept, nz_T )
189         !                                                            ! Index of ocean points
190         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
191         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
192
193         ! Define the U grid FILE ( nid_U )
194
195         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
196         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
197         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
198            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
199            &          0, zjulian, zdt, nh_U, nid_U, domain_id=nidom )
200         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
201            &           "m", ipk, gdept, nz_U )
202         !                                                            ! Index of ocean points
203         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
204         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
205
206         ! Define the V grid FILE ( nid_V )
207
208         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
209         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
210         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
211            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
212            &          0, zjulian, zdt, nh_V, nid_V, domain_id=nidom )
213         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
214            &          "m", ipk, gdept, nz_V )
215         !                                                            ! Index of ocean points
216         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
217         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
218
219         ! Define the W grid FILE ( nid_W )
220
221         CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename
222         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
223         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
224            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
225            &          0, zjulian, zdt, nh_W, nid_W, domain_id=nidom )
226         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
227            &          "m", ipk, gdepw, nz_W )
228 
229
230         ! Declare all the output fields as NETCDF variables
231
232         !                                                                                      !!! nid_T : 3D
233         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
234            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
235         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
236            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
237         !                                                                                      !!! nid_T : 2D
238         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
239            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
240         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
241            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
242#if defined key_dynspg_rl
243         CALL histdef( nid_T, "sobarstf","Barotropic StreamFunction"           , "m3/s2"  ,   &  ! bsf
244            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
245#else
246         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
247            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
248#endif
249#if ! defined key_dynspg_rl && defined key_ice_lim
250         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
251         !    internal damping to Levitus that can be diagnosed from others
252         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
253         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt
254            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
255         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass
256            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
257#endif
258         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp
259            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
260         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
261            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
262         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! emps
263            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
264         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! emps * sn
265            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
266         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qt
267            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
268         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
269            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
270         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
271            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
272         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
273            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
274         CALL histdef( nid_T, "soicecov", "Ice Cover"                          , "[0,1]"  ,   &  ! freeze
275            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
276#if ! defined key_coupled
277         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
278            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
279         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
280            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
281         CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn
282            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
283#endif
284
285#if ( defined key_coupled && ! defined key_ice_lim )
286         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
287            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
288         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
289            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
290         CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn
291            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
292#endif
293#if defined key_diaspr
294         CALL histdef( nid_T, "sosurfps", "Surface Pressure"                   , "cm"     ,   &  ! sp
295            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
296#endif
297         clmx ="l_max(only(x))"    ! max index on a period
298         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX
299            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
300#if defined key_diahth
301         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
302            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
303         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
304            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
305         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
306            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
307         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3
308            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
309#endif
310
311#if defined key_ice_lim && defined key_coupled
312         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
313            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
314         CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
315            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
316#endif
317
318         CALL histend( nid_T )
319
320         !                                                                                      !!! nid_U : 3D
321         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
322            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
323#if defined key_diaeiv
324         CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
325            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
326#endif
327         !                                                                                      !!! nid_U : 2D
328         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! taux
329            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
330#if defined key_dynspg_rl
331         CALL histdef( nid_U, "sozospgx", "Zonal Surface Pressure Gradient"    , "N/kg"   ,   &  ! spgu
332            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
333#endif
334
335         CALL histend( nid_U )
336
337         !                                                                                      !!! nid_V : 3D
338         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
339            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
340#if defined key_diaeiv
341         CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
342            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
343#endif
344         !                                                                                      !!! nid_V : 2D
345         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! tauy
346            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
347#if defined key_dynspg_rl
348         CALL histdef( nid_V, "somespgy", "Meridional Surface Pressure Grad."  , "N/kg"   ,   &  ! spgv
349            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
350#endif
351
352         CALL histend( nid_V )
353
354         !                                                                                      !!! nid_W : 3D
355         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
356            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
357#if defined key_diaeiv
358         CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
359            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
360#endif
361         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
362            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
363
364         CALL histdef( nid_W, "votkeevd", "Enhanced Vertical Diffusivity",       "m2/s"   ,   &  ! avt_evd
365            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
366         !
367         CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avmu
368            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
369
370         CALL histdef( nid_W, "votkeevm", "Enhanced Vertical Viscosity",         "m2/s"   ,   &  ! avmu_evd
371            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
372
373         IF( lk_zdfddm ) THEN
374            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
375               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
376         ENDIF
377         !                                                                                      !!! nid_W : 2D
378#if defined key_traldf_c2d
379         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
380            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
381# if defined key_traldf_eiv 
382            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
383               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
384# endif
385#endif
386
387         CALL histend( nid_W )
388
389         IF(lwp) WRITE(numout,*)
390         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
391         IF(ll_print) CALL FLUSH(numout )
392
393      ENDIF
394
395      ! 2. Start writing data
396      ! ---------------------
397
398      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
399      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
400      ! donne le nombre d'elements, et ndex la liste des indices a sortir
401
402      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN
403         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
404         WRITE(numout,*) '~~~~~~ '
405      ENDIF
406
407      ! Write fields on T grid
408      CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature
409      CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity
410      CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature
411      CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity
412#if defined key_dynspg_rl
413      CALL histwrite( nid_T, "sobarstf", it, bsfn          , ndim_hT, ndex_hT )   ! barotropic streamfunction
414#else
415      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
416#endif
417#if ! defined key_dynspg_rl && defined key_ice_lim
418      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux
419      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
420#endif
421      CALL histwrite( nid_T, "sowaflup", it, emp           , ndim_hT, ndex_hT )   ! upward water flux
422      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
423      CALL histwrite( nid_T, "sowaflcd", it, emps          , ndim_hT, ndex_hT )   ! c/d water flux
424      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1)
425      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
426      CALL histwrite( nid_T, "sohefldo", it, qt            , ndim_hT, ndex_hT )   ! total heat flux
427      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
428      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
429      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
430      CALL histwrite( nid_T, "soicecov", it, freeze        , ndim_hT, ndex_hT )   ! ice cover
431#if ! defined key_coupled
432      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
433      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
434      zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
435      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
436#endif
437#if ( defined key_coupled && ! defined key_ice_lim )
438      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
439      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
440         zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
441      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
442#endif
443#if defined key_diaspr
444      CALL histwrite( nid_T, "sosurfps", it, gps           , ndim_hT, ndex_hT )   ! surface pressure
445#endif
446         zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
447      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
448
449#if defined key_diahth
450      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
451      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
452      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
453      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
454#endif
455#if defined key_ice_lim &&  defined key_coupled 
456      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature
457      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo
458#endif
459         ! Write fields on U grid
460      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
461#if defined key_diaeiv
462      CALL histwrite( nid_U, "vozoeivu", it, u_eiv         , ndim_U , ndex_U )    ! i-eiv current
463#endif
464      CALL histwrite( nid_U, "sozotaux", it, taux          , ndim_hU, ndex_hU )   ! i-wind stress
465#if defined key_dynspg_rl
466      CALL lbc_lnk( spgu, 'U', -1. )
467      CALL histwrite( nid_U, "sozospgx", it, spgu          , ndim_hU, ndex_hU )   ! i-surf. press. grad.
468#endif
469
470         ! Write fields on V grid
471      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
472#if defined key_diaeiv
473      CALL histwrite( nid_V, "vomeeivv", it, v_eiv         , ndim_V , ndex_V  )   ! j-eiv current
474#endif
475      CALL histwrite( nid_V, "sometauy", it, tauy          , ndim_hV, ndex_hV )   ! j-wind stress
476#if defined key_dynspg_rl
477      CALL lbc_lnk( spgv, 'V', -1. )
478      CALL histwrite( nid_V, "somespgy", it, spgv          , ndim_hV, ndex_hV )   ! j-surf. pressure grad.
479#endif
480
481         ! Write fields on W grid
482      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
483#   if defined key_diaeiv
484      CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
485#   endif
486      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
487      CALL histwrite( nid_W, "votkeevd", it, avt_evd        , ndim_T, ndex_T )    ! T enhan. vert. eddy diff. coef.
488      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
489      CALL histwrite( nid_W, "votkeevm", it, avmu_evd       , ndim_T, ndex_T )    ! T enhan. vert. eddy visc. coef.
490      IF( lk_zdfddm ) THEN
491         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
492      ENDIF
493#if defined key_traldf_c2d
494      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
495# if defined key_traldf_eiv
496         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
497# endif
498#endif
499
500      ! 3. Synchronise and close all files
501      ! ---------------------------------------
502      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 ) THEN
503         CALL histsync( nid_T )
504         CALL histsync( nid_U )
505         CALL histsync( nid_V )
506         CALL histsync( nid_W )
507      ENDIF
508
509      !  Create an output files (output.abort.nc) if S < 0 or u > 20 m/s
510      IF( kindic < 0 )   CALL dia_wri_state( 'output.abort' )
511
512      IF( kt == nitend .OR. kindic < 0 ) THEN
513         CALL histclo( nid_T )
514         CALL histclo( nid_U )
515         CALL histclo( nid_V )
516         CALL histclo( nid_W )
517      ENDIF
518
519   END SUBROUTINE dia_wri
520
521
522   SUBROUTINE dia_wri_state( cdfile_name )
523      !!---------------------------------------------------------------------
524      !!                 ***  ROUTINE dia_wri_state  ***
525      !!       
526      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
527      !!      the instantaneous ocean state and forcing fields.
528      !!        Used to find errors in the initial state or save the last
529      !!      ocean state in case of abnormal end of a simulation
530      !!
531      !! ** Method  :   NetCDF files using ioipsl
532      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
533      !!      File 'output.abort.nc' is created in case of abnormal job end
534      !!
535      !! History :
536      !!   8.2  !  00-06  (M. Imbard)  Original code (diabort.F)
537      !!   8.5  !  02-06  (A.Bozec, E. Durand)  Original code (diainit.F)
538      !!   9.0  !  02-12  (G. Madec)  merge of diabort and diainit, F90
539      !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization
540      !!----------------------------------------------------------------------
541      !! * Modules used
542      USE ioipsl
543
544      !! * Arguments
545      CHARACTER (len=* ), INTENT( in ) ::   &
546         cdfile_name      ! name of the file created
547
548      !! * Local declarations
549      CHARACTER (len=40) :: clop
550      INTEGER  ::   &
551         id_i , nz_i, nh_i       
552      INTEGER, DIMENSION(1) ::   &
553         idex             ! temprary workspace
554      REAL(wp) ::   &
555         zsto, zout, zmax,   &
556         zjulian, zdt
557      !!----------------------------------------------------------------------
558
559      IF(lwp) WRITE(numout,*)
560      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
561      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
562      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '.nc'
563     
564      ! 0. Initialisation
565      ! -----------------
566     
567      ! Define frequency of output and means
568      zdt  = rdt
569      zsto = rdt
570      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
571      zout = rdt
572      zmax = ( nitend - nit000 + 1 ) * zdt
573
574      ! 1. Define NETCDF files and fields at beginning of first time step
575      ! -----------------------------------------------------------------
576
577      ! Compute julian date from starting date of the run
578      CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )         ! time axis
579      CALL histbeg( cdfile_name, jpi, glamt, jpj, gphit,   &
580          1, jpi, 1, jpj, 0, zjulian, zdt, nh_i, id_i, domain_id=nidom )          ! Horizontal grid : glamt and gphit
581      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
582          "m", jpk, gdept, nz_i)
583
584      ! Declare all the output fields as NetCDF variables
585
586      CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity
587         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
588      CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature
589         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
590#if defined key_dynspg_rl
591      CALL histdef( id_i, "sobarstf","Barotropic StreamFunction", "m3/s2"  ,   &  ! bsf
592         &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout )
593#else
594      CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh
595         &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout )
596#endif
597      CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current
598         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
599      CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current
600         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
601      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
602         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
603      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater
604         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
605      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
606         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
607      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
608         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
609      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! freeze
610         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
611      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
612         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
613      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
614         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
615
616      CALL histend( id_i )
617
618      ! 2. Start writing data
619      ! ---------------------
620      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de
621      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
622      ! donne le nombre d'elements, et idex la liste des indices a sortir
623      idex(1) = 1   ! init to avoid compil warning
624     
625      ! Write all fields on T grid
626      CALL histwrite( id_i, "votemper", 1, tn    , jpi*jpj*jpk, idex )    ! now temperature
627      CALL histwrite( id_i, "vosaline", 1, sn    , jpi*jpj*jpk, idex )    ! now salinity
628#if defined key_dynspg_rl
629      CALL histwrite( id_i, "sobarstf", 1, bsfn  , jpi*jpj    , idex )    ! barotropic streamfunction
630#else
631      CALL histwrite( id_i, "sossheig", 1, sshn  , jpi*jpj    , idex )    ! sea surface height
632#endif
633      CALL histwrite( id_i, "vozocrtx", 1, un    , jpi*jpj*jpk, idex )    ! now i-velocity
634      CALL histwrite( id_i, "vomecrty", 1, vn    , jpi*jpj*jpk, idex )    ! now j-velocity
635      CALL histwrite( id_i, "vovecrtz", 1, wn    , jpi*jpj*jpk, idex )    ! now k-velocity
636      CALL histwrite( id_i, "sowaflup", 1, emp   , jpi*jpj    , idex )    ! freshwater budget
637      CALL histwrite( id_i, "sohefldo", 1, qt    , jpi*jpj    , idex )    ! total heat flux
638      CALL histwrite( id_i, "soshfldo", 1, qsr   , jpi*jpj    , idex )    ! total heat flux
639      CALL histwrite( id_i, "soicecov", 1, freeze, jpi*jpj    , idex )    ! ice cover
640      CALL histwrite( id_i, "sozotaux", 1, taux  , jpi*jpj    , idex )    ! i-wind stress
641      CALL histwrite( id_i, "sometauy", 1, tauy  , jpi*jpj    , idex )    ! j-wind stress
642
643      ! 3. Close the file
644      ! -----------------
645      CALL histclo( id_i )
646
647   END SUBROUTINE dia_wri_state
648 
649#endif
650   !!======================================================================
651END MODULE diawri
Note: See TracBrowser for help on using the repository browser.