init_3d_ncdf.F90 11.2 KB
Newer Older
1
!$Id: init_3d_ncdf.F90,v 1.10 2005-09-23 11:27:10 kbk Exp $
gotm's avatar
gotm committed
2 3 4 5
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
6
! !IROUTINE: Initialise 3D netCDF variables
gotm's avatar
gotm committed
7 8 9 10 11 12 13
!
! !INTERFACE:
   subroutine init_3d_ncdf(fn,title,starttime)
!
! !DESCRIPTION:
!
! !USES:
14 15
   use exceptions
   use ncdf_common
gotm's avatar
gotm committed
16
   use ncdf_3d
17 18 19
   use domain, only: ioff,joff
   use domain, only: imin,imax,jmin,jmax,kmax
   use domain, only: vert_cord
20 21 22
#ifdef GETM_BIO
   use bio_var, only: numc,var_names,var_units,var_long
#endif
23

gotm's avatar
gotm committed
24 25 26
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
kbk's avatar
kbk committed
27
   character(len=*), intent(in)        :: fn,title,starttime
gotm's avatar
gotm committed
28
!
29 30
! !DEFINED PARAMETERS:
   logical,    parameter               :: init3d=.true.
gotm's avatar
gotm committed
31 32 33 34
!
! !REVISION HISTORY:
!
!  $Log: init_3d_ncdf.F90,v $
35 36 37 38
!  Revision 1.10  2005-09-23 11:27:10  kbk
!  support for biology via GOTMs biology modules
!
!  Revision 1.9  2005/04/25 09:32:34  kbk
39 40 41
!  added NetCDF IO rewrite + de-stag of velocities - Umlauf
!
!  Revision 1.8  2004/10/07 15:46:56  kbk
42 43 44
!  removed wrongly placed  comments for save_nuh
!
!  Revision 1.7  2004/06/15 08:25:57  kbk
kbk's avatar
kbk committed
45 46 47
!  added supoort for spm - Ruiz
!
!  Revision 1.6  2004/05/04 09:23:51  kbk
48 49 50
!  hydrostatic consistency criteria stored in .3d.nc file
!
!  Revision 1.5  2003/12/16 12:51:04  kbk
51 52 53
!  preparing for proper support for SPM (manuel)
!
!  Revision 1.4  2003/05/09 11:38:26  kbk
54 55 56
!  added proper undef support - based on Adolf Stips patch
!
!  Revision 1.3  2003/04/23 11:53:24  kbk
kbk's avatar
kbk committed
57 58 59
!  save lat/lon info for spherical grid
!
!  Revision 1.2  2003/04/07 12:51:26  kbk
60 61 62 63
!  CURVILINEAR --> defined(SPHERICAL) || defined(CURVILINEAR)
!
!  Revision 1.1.1.1  2002/05/02 14:01:46  gotm
!  recovering after CVS crash
gotm's avatar
gotm committed
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
!
!  Revision 1.7  2001/10/25 16:16:20  bbh
!  No actual storing of data in init_3d_ncdf.F90 -> save_3d_ncdf.F90
!
!  Revision 1.6  2001/10/23 14:19:20  bbh
!  Stores h if general vertical coordinates
!
!  Revision 1.5  2001/10/23 07:37:17  bbh
!  Saving spm - if calc_spm and save_spm are both true
!
!  Revision 1.4  2001/10/22 08:03:13  bbh
!  Misplaced #else
!
!  Revision 1.3  2001/09/24 14:13:25  bbh
!  xc and yc have changing shape depending on grid_type
!
!  Revision 1.2  2001/09/19 11:20:32  bbh
!  Explicit de-allocates memory when -DFORTRAN90
!
!  Revision 1.1  2001/09/13 14:50:02  bbh
!  Cleaner and smaller NetCDF implementation + better axis support
!
! !LOCAL VARIABLES:
87
   integer                   :: err
88
   integer                   :: n,rc
89
   integer                   :: xlen,ylen,zlen
kbk's avatar
kbk committed
90 91 92
   integer                   :: scalar(1),axisdim(1),f3_dims(3),f4_dims(4)
   REALTYPE                  :: fv,mv,vr(2)
   character(len=80)         :: history,ts
gotm's avatar
gotm committed
93 94 95 96 97
!EOP
!-------------------------------------------------------------------------
!BOC
   include "netcdf.inc"

98
!  create netCDF file
gotm's avatar
gotm committed
99 100 101
   err = nf_create(fn, NF_CLOBBER, ncid)
   if (err .NE. NF_NOERR) go to 10

102 103
!  initialize all time-independent, grid related variables
   call init_grid_ncdf(ncid,init3d,x_dim,y_dim,z_dim)
gotm's avatar
gotm committed
104

105 106 107 108
!  length of netCDF dimensions
   xlen = imax-imin+1
   ylen = jmax-jmin+1
   zlen = kmax+1
gotm's avatar
gotm committed
109

110 111 112 113
!  allocate workspace
   allocate(ws(xlen*ylen*zlen),stat=err)
   if (err .ne. 0) call getm_error("init_3d_ncdf()",               &
                                   "error allocating ws")
gotm's avatar
gotm committed
114

115
!  define unlimited dimension
gotm's avatar
gotm committed
116 117 118
   err = nf_def_dim(ncid,'time',NF_UNLIMITED,time_dim)
   if (err .NE. NF_NOERR) go to 10

119
!  netCDF dimension vectors
kbk's avatar
kbk committed
120 121 122
   f3_dims(3)= time_dim
   f3_dims(2)= y_dim
   f3_dims(1)= x_dim
gotm's avatar
gotm committed
123

kbk's avatar
kbk committed
124 125 126 127
   f4_dims(4)= time_dim
   f4_dims(3)= z_dim
   f4_dims(2)= y_dim
   f4_dims(1)= x_dim
gotm's avatar
gotm committed
128

129 130

!  gobal settings
gotm's avatar
gotm committed
131 132 133 134 135 136 137 138 139
   history = 'Generated by getm, ver. '//RELEASE
   ts = 'seconds since '//starttime

!  time
   axisdim(1) = time_dim
   err = nf_def_var(ncid,'time',NF_REAL,1,axisdim,time_id)
   if (err .NE. NF_NOERR) go to 10
   call set_attributes(ncid,time_id,units=trim(ts),long_name='time')

140

gotm's avatar
gotm committed
141 142 143
!  elevation
   err = nf_def_var(ncid,'elev',NF_REAL,3,f3_dims,elev_id)
   if (err .NE. NF_NOERR) go to 10
144 145
   fv = elev_missing
   mv = elev_missing
gotm's avatar
gotm committed
146 147
   vr(1) = -15.
   vr(2) =  15.
148
   call set_attributes(ncid,elev_id,long_name='elevation',units='m', &
kbk's avatar
kbk committed
149
                       FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
150 151 152 153

!  depth integrated zonal velocity
   err = nf_def_var(ncid,'u',NF_REAL,3,f3_dims,u_id)
   if (err .NE. NF_NOERR) go to 10
154 155
   fv = vel_missing
   mv = vel_missing
gotm's avatar
gotm committed
156 157 158
   vr(1) = -3.
   vr(2) =  3.
   call set_attributes(ncid,u_id,long_name='int. zonal vel.',units='m/s', &
kbk's avatar
kbk committed
159
                       FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
160

161
!  depth integrated meridional velocity
gotm's avatar
gotm committed
162 163
   err = nf_def_var(ncid,'v',NF_REAL,3,f3_dims,v_id)
   if (err .NE. NF_NOERR) go to 10
164 165
   fv = vel_missing
   mv = vel_missing
gotm's avatar
gotm committed
166 167 168
   vr(1) = -3.
   vr(2) =  3.
   call set_attributes(ncid,v_id,long_name='int. meridional vel.',units='m/s', &
kbk's avatar
kbk committed
169
                       FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
170 171 172 173

   select case (vert_cord)
      case (1)
      case (2)
174
         call getm_error("init_3d_ncdf()","saving of z-levels disabled")
gotm's avatar
gotm committed
175
      case (3)
176 177
         fv = hh_missing
         mv = hh_missing
gotm's avatar
gotm committed
178 179
         err = nf_def_var(ncid,'h',NF_REAL,4,f4_dims,h_id)
         if (err .NE. NF_NOERR) go to 10
kbk's avatar
kbk committed
180
         call set_attributes(ncid,h_id,long_name='layer thickness',  &
181
                             units='m',FillValue=fv,missing_value=mv)
gotm's avatar
gotm committed
182 183 184
      case default
   end select

185 186 187 188 189 190 191 192 193 194 195 196 197 198 199

!  hydrostatic consistency criterion
   err = nf_def_var(ncid,'hcc',NF_REAL,3,f4_dims,hcc_id)
   if (err .NE. NF_NOERR) go to 10
   fv = -_ONE_ 
   mv = -_ONE_
   vr(1) = 0.
   vr(2) = 1.
   call set_attributes(ncid,hcc_id,  &
                       long_name='hcc',units=' ',          &
                       FillValue=fv,missing_value=mv,valid_range=vr)




gotm's avatar
gotm committed
200
   if (save_vel) then
201 202
      fv = vel_missing
      mv = vel_missing
gotm's avatar
gotm committed
203 204 205 206 207 208 209
      vr(1) = -3.
      vr(2) =  3.

!     zonal velocity
      err = nf_def_var(ncid,'uu',NF_REAL,4,f4_dims,uu_id)
      if (err .NE. NF_NOERR) go to 10
      call set_attributes(ncid,uu_id,long_name='zonal vel.',units='m/s', &
kbk's avatar
kbk committed
210
                          FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
211 212 213 214 215

!     meridional velocity
      err = nf_def_var(ncid,'vv',NF_REAL,4,f4_dims,vv_id)
      if (err .NE. NF_NOERR) go to 10
      call set_attributes(ncid,vv_id,long_name='meridional vel.',units='m/s', &
kbk's avatar
kbk committed
216
                          FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
217 218 219 220 221

!     vertical velocity
      err = nf_def_var(ncid,'w',NF_REAL,4,f4_dims,w_id)
      if (err .NE. NF_NOERR) go to 10
      call set_attributes(ncid,w_id,long_name='vertical vel.',units='m/s', &
kbk's avatar
kbk committed
222
                          FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
223 224 225 226 227
   end if

   if (save_strho) then

      if (save_s) then
228 229
         fv = salt_missing
         mv = salt_missing
gotm's avatar
gotm committed
230 231 232 233 234
         vr(1) =  0.
         vr(2) = 40.
         err = nf_def_var(ncid,'salt',NF_REAL,4,f4_dims,salt_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,salt_id,long_name='salinity',units='PSU', &
kbk's avatar
kbk committed
235
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
236 237 238
      end if

      if (save_t) then
239 240
         fv = temp_missing
         mv = temp_missing
gotm's avatar
gotm committed
241 242 243 244 245
         vr(1) =  0.
         vr(2) = 40.
         err = nf_def_var(ncid,'temp',NF_REAL,4,f4_dims,temp_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,temp_id,long_name='temperature',units='degC',&
kbk's avatar
kbk committed
246
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
247 248 249
      end if

      if (save_rho) then
250 251
         fv = rho_missing
         mv = rho_missing
gotm's avatar
gotm committed
252 253 254 255 256
         vr(1) =  0.
         vr(2) = 30.
         err = nf_def_var(ncid,'sigma_t',NF_REAL,4,f4_dims,sigma_t_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,sigma_t_id,long_name='sigma_t',units='kg/m3',&
kbk's avatar
kbk committed
257
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
258 259 260 261 262 263
      end if
   end if

   if (save_turb) then

      if (save_tke) then
264 265
         fv = tke_missing
         mv = tke_missing
gotm's avatar
gotm committed
266 267 268 269 270
         vr(1) = 0.
         vr(2) = 0.2
         err = nf_def_var(ncid,'tke',NF_REAL,4,f4_dims,tke_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,tke_id,long_name='TKE',units='m2/s2', &
kbk's avatar
kbk committed
271
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
272 273 274
      end if

      if (save_num) then
275 276
         fv = num_missing
         mv = num_missing
gotm's avatar
gotm committed
277 278 279 280 281
         vr(1) = 0.
         vr(2) = 0.2
         err = nf_def_var(ncid,'num',NF_REAL,4,f4_dims,num_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,num_id,long_name='viscosity',units='m2/s', &
kbk's avatar
kbk committed
282
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
283 284
      end if

285
      if (save_nuh) then
286 287
         fv = nuh_missing
         mv = nuh_missing
gotm's avatar
gotm committed
288 289 290 291 292
         vr(1) = 0.
         vr(2) = 0.2
         err = nf_def_var(ncid,'nuh',NF_REAL,4,f4_dims,nuh_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,nuh_id,long_name='diffusivity',units='m2/s', &
kbk's avatar
kbk committed
293
                             FillValue=fv,missing_value=mv,valid_range=vr)
294
      end if
gotm's avatar
gotm committed
295 296

      if (save_eps) then
297 298
         fv = eps_missing
         mv = eps_missing
gotm's avatar
gotm committed
299 300 301 302 303
         vr(1) = 0.
         vr(2) = 0.2
         err = nf_def_var(ncid,'diss',NF_REAL,4,f4_dims,eps_id)
         if (err .NE. NF_NOERR) go to 10
         call set_attributes(ncid,eps_id,long_name='dissipation',units='m2/s3',&
kbk's avatar
kbk committed
304
                             FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
305 306 307
      end if
   end if

308
#ifdef SPM
gotm's avatar
gotm committed
309
   if (save_spm) then
310 311
      fv = spm_missing
      mv = spm_missing
kbk's avatar
kbk committed
312 313 314 315 316 317 318
      err = nf_def_var(ncid,'spm_pool',NF_REAL,3,f3_dims,spmpool_id) 
      if (err .NE. NF_NOERR) go to 10
      vr(1) = 0.
      vr(2) = 10.
      call set_attributes(ncid,spmpool_id,long_name='bottom spm pool', &
                          units='kg/m2', & 
                          FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
319 320 321 322
      vr(1) =  0.
      vr(2) = 30.
      err = nf_def_var(ncid,'spm',NF_REAL,4,f4_dims,spm_id)
      if (err .NE. NF_NOERR) go to 10
kbk's avatar
kbk committed
323
      call set_attributes(ncid,spm_id,  &
kbk's avatar
kbk committed
324 325 326
                          long_name='suspended particulate matter', &
                          units='kg/m3', &
                          FillValue=fv,missing_value=mv,valid_range=vr)
gotm's avatar
gotm committed
327
   end if
328
#endif
kbk's avatar
kbk committed
329

330 331 332 333 334 335 336 337 338 339 340 341
#ifdef GETM_BIO
   allocate(bio_ids(numc),stat=rc)
   if (rc /= 0) stop 'init_3d_ncdf(): Error allocating memory (bio_ids)'
   STDERR numc
   fv = bio_missing
   mv = bio_missing
   vr(1) = _ZERO_
   vr(2) = 9999.
   do n=1,numc
      err = nf_def_var(ncid,var_names(n),NF_REAL,4,f4_dims,bio_ids(n))
      if (err .NE.  NF_NOERR) go to 10
      call set_attributes(ncid,bio_ids(n), &
342 343
                          long_name=trim(var_long(n)), &
                          units=trim(var_units(n)), &
344 345 346 347
                          FillValue=fv,missing_value=mv,valid_range=vr)
   end do
#endif

gotm's avatar
gotm committed
348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368
!  globals
   err = nf_put_att_text(ncid,NF_GLOBAL,'title',LEN_TRIM(title),title)
   if (err .NE. NF_NOERR) go to 10

   err = nf_put_att_text(ncid,NF_GLOBAL,'history',LEN_TRIM(history),history)
   if (err .NE. NF_NOERR) go to 10

   ! leave define mode
   err = nf_enddef(ncid)
   if (err .NE. NF_NOERR) go to 10

   return

   10 FATAL 'init_3d_ncdf: ',nf_strerror(err)
   stop 'init_3d_ncdf'
   end subroutine init_3d_ncdf
!EOC

!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH)         !
!-----------------------------------------------------------------------