My Project
enkf_ncdio.f90
Go to the documentation of this file.
1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 !!$/=============================================================================/
13 !!$Copyright (c) 2007, The University of Massachusetts Dartmouth
14 !!$Produced at the School of Marine Science & Technology
15 !!$Marine Ecosystem Dynamics Modeling group
16 !!$All rights reserved.
17 !!$
18 !!$The FVCOM Offline Lagrangian Model has been developed by the joint UMASSD-WHOI
19 !!$research team. For details of authorship and attribution of credit please see
20 !!$the FVCOM technical manual or contact the MEDM group.
21 !!$
22 !!$
23 !!$This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu/ The
24 !!$full copyright notice is contained in the file COPYRIGHT located in the root
25 !!$directory of the FVCOM code. This original header must be maintained in all
26 !!$distributed versions.
27 !!$
28 !!$THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
29 !!$ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
30 !!$IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
31 !!$ARE DISCLAIMED.
32 !!$
33 !!$/-----------------------------------------------------------------------------/
34 !!$CVS VERSION INFORMATION
35 !!$$Id$
36 !!$$Name$
37 !!$$Revision$
38 !!$/=============================================================================/
39 ! VERSION 2.0
40 ! created by Martin Huret
41 ! modified by J. Churchill
42 
43 
44 
45 ! *** VERSION CREATED BY JHC (04/07) TO GET TIME FROM NETCDF FILE ON NCD_READ CALL ***
46 ! *** AND TO OUTPUT SURFACE ELEVATION AND BOTTOM DEPTH ON NCD_WRITE CALL ***
47 ! *** modified (08/07) to re-try opening the input cdf file on error ******
48 
49 SUBROUTINE ncd_read_grid(INFILE)
50  !---------------------------------------------------------------------
51  ! READ DIMENSIONS IN A NETCDF FILES
52  !---------------------------------------------------------------------
53  USE mod_ncd
54  USE lims
55  IMPLICIT NONE
56  !----------------------------------------------------------------------------!
57  CHARACTER(LEN=100), INTENT(IN) :: INFILE
58  !----------------------------------------------------------------------------!
59  INTEGER :: IERR
60  INTEGER :: N_ELEMS,N_NODES,N_SIG_M1,N_SIG
61  REAL(SP), ALLOCATABLE, DIMENSION(:,:) :: TEMP
62  !----------------------------------------------------------------------------!
63 
64  !--Open NetCDF DATA FILE
65  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
66  IF(ierr /=nf90_noerr)THEN
67  WRITE(*,*)'ERROR READING ',trim(infile)
68  WRITE(*,*)trim(nf90_strerror(ierr))
69  stop
70  END IF
71 
72  !--Get Model Dimensions
73  n_elems = getdim(nc_fid,len_trim('nele'),'nele')
74  n_nodes = getdim(nc_fid,len_trim('node'),'node')
75  n_sig_m1 = getdim(nc_fid,len_trim('siglay'),'siglay')
76  n_sig = getdim(nc_fid,len_trim('siglev'),'siglev')
77 
78  m=n_nodes
79  n=n_elems
80  kb=n_sig
81  kbm1=n_sig_m1
82  kbm2=kb-2
83 
84  !--close file
85  ierr = nf90_close(nc_fid)
86 
87  RETURN
88 END SUBROUTINE ncd_read_grid
89 
90 !==============================================================================|
91 
92 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
93 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
94 
95 !==============================================================================|
96 
97 SUBROUTINE ncd_read_shape(INFILE)
98  !---------------------------------------------------------------------
99  ! READ BATHYMETRY, SIGMA LEVELS AND GRID COEFFICIENTS IN A NETCDF FILES
100  !---------------------------------------------------------------------
101  USE mod_ncd
102  USE all_vars
103  IMPLICIT NONE
104  !----------------------------------------------------------------------------!
105  CHARACTER(LEN=100), INTENT(IN) :: INFILE
106  !----------------------------------------------------------------------------!
107  INTEGER :: IERR
108  INTEGER :: K,I
109  REAL(SP), ALLOCATABLE, DIMENSION(:,:) :: TEMP
110 
111  !--OPEN NETCDF DATA FILE
112  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
113  IF(ierr /=nf90_noerr)THEN
114  WRITE(*,*)'ERROR READING ',trim(infile)
115  WRITE(*,*)trim(nf90_strerror(ierr))
116  stop
117  END IF
118 
119  !--Get Node Coordinates
120  ALLOCATE(temp(m,1))
121  CALL getsvar(nc_fid,len_trim('lon'),'lon',m,1,temp)
122  vx(1:m) = temp(1:m,1)
123  WHERE(vx < 0.0_sp) vx=360.0_sp+vx
124  DEALLOCATE(temp)
125 
126  ALLOCATE(temp(m,1))
127  CALL getsvar(nc_fid,len_trim('lat'),'lat',m,1,temp)
128  vy(1:m) = temp(1:m,1)
129  DEALLOCATE(temp)
130 
131  !--Get Node Numbering
132  ALLOCATE(temp(n,3))
133  CALL getsvar(nc_fid,len_trim('nv'),'nv',n,3,temp)
134  nv(1:n,1:3) = temp(1:n,1:3)
135  DEALLOCATE(temp)
136  nv(:,4) = nv(:,1)
137 
138  !--Get Bathymetry
139  ALLOCATE(temp(n,1))
140  CALL getsvar(nc_fid,len_trim('h'),'h',m,1,temp)
141  h(1:m) = temp(1:m,1)
142  DEALLOCATE(temp)
143 
144  !--Get Sigma levels
145  ALLOCATE(temp(m,kb))
146  CALL getsvar(nc_fid,len_trim('siglev'),'siglev',m,kb,temp)
147  z(1:m,1:kb) = temp(1:m,1:kb)
148  DEALLOCATE(temp)
149 
150  !--Compute derivative and intra-sigma levels
151  DO k=1,kbm1
152  zz(:,k)=0.5_sp*(z(:,k)+z(:,k+1))
153  dz(:,k)=z(:,k)-z(:,k+1)
154  END DO
155  zz(:,kb)=2.0_sp*zz(:,kbm1)-zz(:,kbm2)
156 
157  DO k=1,kbm2
158  dzz(:,k)=zz(:,k)-zz(:,k+1)
159  END DO
160  dzz(:,kb-1)=0.0
161  dz(:,kb)=0.0
162 
163  DO i=1,n
164  z1(i,:) = (z(nv(i,1),:)+z(nv(i,2),:)+z(nv(i,3),:))/3.0
165  zz1(i,:) = (zz(nv(i,1),:)+zz(nv(i,2),:)+zz(nv(i,3),:))/3.0
166  dz1(i,:) = (dz(nv(i,1),:)+dz(nv(i,2),:)+dz(nv(i,3),:))/3.0
167  dzz1(i,:) = (dzz(nv(i,1),:)+dzz(nv(i,2),:)+dzz(nv(i,3),:))/3.0
168  END DO
169  !--Get Interpolation Parameters
170  ALLOCATE(temp(n,4))
171  CALL getsvar(nc_fid,len_trim('a1u'),'a1u',n,4,temp)
172  a1u(1:n,:) = temp(1:n,:)
173  DEALLOCATE(temp)
174 
175  ALLOCATE(temp(n,4))
176  CALL getsvar(nc_fid,len_trim('a2u'),'a2u',n,4,temp)
177  a2u(1:n,:) = temp(1:n,:)
178  DEALLOCATE(temp)
179 
180  ALLOCATE(temp(n,3))
181  CALL getsvar(nc_fid,len_trim('aw0'),'aw0',n,3,temp)
182  aw0(1:n,:) = temp(1:n,:)
183  DEALLOCATE(temp)
184 
185  ALLOCATE(temp(n,3))
186  CALL getsvar(nc_fid,len_trim('awx'),'awx',n,3,temp)
187  awx(1:n,:) = temp(1:n,:)
188  DEALLOCATE(temp)
189 
190  ALLOCATE(temp(n,3))
191  CALL getsvar(nc_fid,len_trim('awy'),'awy',n,3,temp)
192  awy(1:n,:) = temp(1:n,:)
193  DEALLOCATE(temp)
194 
195  !--Close file
196  ierr = nf90_close(nc_fid)
197 
198  RETURN
199 END SUBROUTINE ncd_read_shape
200 
201 !==============================================================================|
202 
203 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
204 ! **************MODIFIED BY JCH (04/07) TO ACQUIRE TIME FROM NETCDF FILE AT "LEVEL' OF READ
205 SUBROUTINE ncd_find_read_time_enkf(INFILE,Time,HO)
207  USE all_vars, ONLY : nv
208  USE lims
209  IMPLICIT NONE
210  !----------------------------------------------------------------------------!
211  REAL(DP), INTENT(IN) :: time
212  INTEGER, INTENT(OUT) :: HO
213  CHARACTER(LEN=*), INTENT(IN) :: INFILE
214  !----------------------------------------------------------------------------!
215  INTEGER :: IERR
216  INTEGER :: HT,I
217  REAL(DP), ALLOCATABLE, DIMENSION(:,:) :: TEMP,TEMP2
218  INTEGER :: N_TIMES
219  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
220  IF(ierr /=nf90_noerr)THEN
221  WRITE(*,*)'ERROR READING ',trim(infile)
222  WRITE(*,*)trim(nf90_strerror(ierr))
223  WRITE(*,*)' Second Try'
224  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
225  IF(ierr /=nf90_noerr)THEN
226  WRITE(*,*)' 2nd ERROR READING ',trim(infile)
227  WRITE(*,*)trim(nf90_strerror(ierr))
228  WRITE(*,*)' Third Try'
229  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
230  IF(ierr /=nf90_noerr)THEN
231  WRITE(*,*)' 3rd ERROR READING ',trim(infile)
232  WRITE(*,*)trim(nf90_strerror(ierr))
233  WRITE(*,*)' Yer Out!'
234  stop
235  END IF
236  END IF
237  END IF
238  !---------------------------------------------------------------------
239  ! Read Data from file INFILE at time level ht
240  !---------------------------------------------------------------------
241  n_times = getdim(nc_fid,len_trim('time'),'time') ! number of times in file
242 
243  ALLOCATE(temp(n_times,1))
244 
245  CALL getsvar_d(nc_fid,len_trim('time'),'time',n_times,1,temp)
246 
247  do i=1, n_times
248  if (abs(temp(i,1)-time)<1e-6) then
249  ho=i-1 ! NEED TO MINUS BECAUSE WE ASSUME THE FIRST ONE IS ZERO
250  print *, "FIND THE DATA INDEX MATCHING CURRENT TIME STEP :", ho+1 , temp(ho+1,1)
251  RETURN
252  end if
253  end do
254  DEALLOCATE(temp)
255 
256  ierr = nf90_close(nc_fid)
257  print *, 'dont find the nc index match current time:', time
258  stop
259  RETURN
260 
261 END SUBROUTINE ncd_find_read_time_enkf
262 SUBROUTINE ncd_read_enkf(INFILE,UL,VL,T1L,S1L,ELL,HO)
263  !---------------------------------------------------------------------
264  ! READ DATA FROM DAILY NETCDF FILES
265  !---------------------------------------------------------------------
266 
267  USE mod_ncd
268  USE all_vars, ONLY : nv
269  USE lims
270  IMPLICIT NONE
271 
272  !----------------------------------------------------------------------------!
273  REAL(SP), DIMENSION(0:NGL,KB),INTENT(OUT) :: UL,VL
274  REAL(SP), DIMENSION(0:MGL,KB),INTENT(OUT) :: T1L,S1L
275  ! REAL(SP), DIMENSION(0:M,KB),INTENT(OUT) :: T1L
276  REAL(SP), DIMENSION(0:MGL),INTENT(OUT) :: ELL
277 ! REAL(SP), INTENT(OUT) :: time
278  INTEGER, INTENT(IN) :: HO
279  CHARACTER(LEN=*), INTENT(IN) :: INFILE
280  !----------------------------------------------------------------------------!
281  INTEGER :: IERR
282  INTEGER :: HT,I
283  REAL(SP), ALLOCATABLE, DIMENSION(:,:) :: TEMP,TEMP2
284  INTEGER :: N_TIMES
285  ul=0.0
286  vl=0.0
287  t1l=0.0
288  s1l=0.0
289  ell=0.0
290 
291  !--Adjustement to read in Netcdf file
292  ht=ho+1
293  print *, 'nc read from:', infile, " in hour: ",ht
294  !--Open NetCDF Datafile
295 
296 ! **** MODIFIED 08/07 BY JHC TO RETRY OPENING THE INPUT FILE TWICE ON ERROR
297 
298  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
299  IF(ierr /=nf90_noerr)THEN
300  WRITE(*,*)'ERROR READING ',trim(infile)
301  WRITE(*,*)trim(nf90_strerror(ierr))
302  WRITE(*,*)' Second Try'
303  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
304  IF(ierr /=nf90_noerr)THEN
305  WRITE(*,*)' 2nd ERROR READING ',trim(infile)
306  WRITE(*,*)trim(nf90_strerror(ierr))
307  WRITE(*,*)' Third Try'
308  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
309  IF(ierr /=nf90_noerr)THEN
310  WRITE(*,*)' 3rd ERROR READING ',trim(infile)
311  WRITE(*,*)trim(nf90_strerror(ierr))
312  WRITE(*,*)' Yer Out!'
313  stop
314  END IF
315  END IF
316  END IF
317 
318  !---------------------------------------------------------------------
319  ! Read Data from file INFILE at time level ht
320  !---------------------------------------------------------------------
321 
322  ! ----- ADDED BY JHC (04/07) TO GET time (SECONDS AFTER START TIME) OF EACH READ------
323 
324 ! N_TIMES = GETDIM(NC_FID,LEN_TRIM('time'),'time') ! number of times in file
325 
326 ! ALLOCATE(TEMP(HT,1))
327 
328 ! CALL GETSVAR(NC_FID,LEN_TRIM('time'),'time',HT,1,TEMP)
329 
330 
331 ! time = TEMP(HT,1)
332 ! DEALLOCATE(TEMP)
333 
334  !--free surface elevation
335  print *, 'finish open nc file'
336  ALLOCATE(temp(mgl,1))
337  CALL getdvar(nc_fid,len_trim('zeta'),'zeta',mgl,1,temp,ht)
338  ell(1:mgl) = temp(1:mgl,1)
339  DEALLOCATE(temp)
340  print *, 'finish reading el'
341  !--salinity
342  ALLOCATE(temp(mgl,kbm1))
343  CALL getdvar(nc_fid,len_trim('salinity'),'salinity',mgl,kbm1,temp,ht)
344  s1l(1:mgl,1:kbm1) = temp(1:mgl,1:kbm1)
345  DEALLOCATE(temp)
346  print *, 'finish reading salinity'
347  ! temperature
348  ALLOCATE(temp(mgl,kbm1))
349  CALL getdvar(nc_fid,len_trim('temp'),'temp',mgl,kbm1,temp,ht)
350  t1l(1:mgl,1:kbm1) = temp(1:mgl,1:kbm1)
351  DEALLOCATE(temp)
352  print *, 'finish reading temp'
353 
354  !--U velocity
355  ALLOCATE(temp(ngl,kbm1))
356  CALL getdvar(nc_fid,len_trim('u'),'u',ngl,kbm1,temp,ht)
357  ul(1:ngl,1:kbm1) = temp(1:ngl,1:kbm1)
358  DEALLOCATE(temp)
359  print *, 'finish reading u'
360  !--V velocity
361  ALLOCATE(temp(ngl,kbm1))
362  CALL getdvar(nc_fid,len_trim('v'),'v',ngl,kbm1,temp,ht)
363  vl(1:ngl,1:kbm1) = temp(1:ngl,1:kbm1)
364  DEALLOCATE(temp)
365  print *, 'finish reading v'
366 !----------------------------here you have to check what name and format(node or cell) you output
367  !--WW velocity
368 ! ALLOCATE(TEMP(N,KBM1))
369 ! CALL GETDVAR(NC_FID,LEN_TRIM('ww'),'ww',N,KBM1,TEMP,HT)
370 ! WWL(1:N,1:KBM1) = TEMP(1:N,1:KBM1)
371 ! DEALLOCATE(TEMP)
372  !--W velocity (omega)
373 ! ALLOCATE(TEMP(M,KBM1))
374 ! ALLOCATE(TEMP2(N,KBM1))
375 !print *, 'do not read omega, set to zero:'
376 !temp=0.0
377 ! CALL GETDVAR(NC_FID,LEN_TRIM('omega'),'omega',M,KBM1,TEMP,HT) !original
378 ! CALL GETDVAR(NC_FID,LEN_TRIM('wts'),'wts',M,KBM1,TEMP,HT) !pengfei some case people output as wts, maybe from cell(N) or from node(M)
379 ! DO I = 1,N
380 ! TEMP2(I,:) = ((TEMP(NV(I,1),:))+(TEMP(NV(I,2),:))+(TEMP(NV(I,3),:)))/3.0
381 ! END DO
382 ! WWL(1:N,1:KBM1) = TEMP2(1:N,1:KBM1)
383 ! DEALLOCATE(TEMP,TEMP2)
384 
385  !--KH
386 ! ALLOCATE(TEMP(M,KBM1))
387 !print *, 'do not read km, set to zero'
388 !temp=0.0
389 ! CALL GETDVAR(NC_FID,LEN_TRIM('km'),'km',M,KBM1,TEMP,HT)
390 ! KHL(1:M,1:KBM1) = TEMP(1:M,1:KBM1)
391 ! DEALLOCATE(TEMP)
392 
393  !--Close file
394  ierr = nf90_close(nc_fid)
395 
396  RETURN
397 END SUBROUTINE ncd_read_enkf
398 
399 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
400 
401 !==============================================================================|
402 
403 
404 ! **************MODIFIED BY JCH (04/07) TO ACQUIRE TIME FROM NETCDF FILE AT "LEVEL' OF READ
405 
406 SUBROUTINE ncd_read(INFILE,UL,VL,WWL,KHL,ELL,time,HO)
407  !---------------------------------------------------------------------
408  ! READ DATA FROM DAILY NETCDF FILES
409  !---------------------------------------------------------------------
410 
411  USE mod_ncd
412  USE all_vars, ONLY : nv
413  USE lims
414  IMPLICIT NONE
415 
416  !----------------------------------------------------------------------------!
417  REAL(SP), DIMENSION(0:N,KB),INTENT(OUT) :: UL,VL,WWL
418  REAL(SP), DIMENSION(0:M,KB),INTENT(OUT) :: KHL
419  ! REAL(SP), DIMENSION(0:M,KB),INTENT(OUT) :: T1L
420  REAL(SP), DIMENSION(0:M),INTENT(OUT) :: ELL
421  REAL(SP), INTENT(OUT) :: time
422  INTEGER, INTENT(IN) :: HO
423  CHARACTER(LEN=100), INTENT(IN) :: INFILE
424  !----------------------------------------------------------------------------!
425  INTEGER :: IERR
426  INTEGER :: HT,I
427  REAL(SP), ALLOCATABLE, DIMENSION(:,:) :: TEMP,TEMP2
428  INTEGER :: N_TIMES
429 
430 
431  !--Adjustement to read in Netcdf file
432  ht=ho+1
433  print *, 'nc read from:', infile, "in hour: ",ht
434  !--Open NetCDF Datafile
435 
436 ! **** MODIFIED 08/07 BY JHC TO RETRY OPENING THE INPUT FILE TWICE ON ERROR
437 
438  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
439  IF(ierr /=nf90_noerr)THEN
440  WRITE(*,*)'ERROR READING ',trim(infile)
441  WRITE(*,*)trim(nf90_strerror(ierr))
442  WRITE(*,*)' Second Try'
443  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
444  IF(ierr /=nf90_noerr)THEN
445  WRITE(*,*)' 2nd ERROR READING ',trim(infile)
446  WRITE(*,*)trim(nf90_strerror(ierr))
447  WRITE(*,*)' Third Try'
448  ierr = nf90_open(trim(infile),nf90_nowrite,nc_fid)
449  IF(ierr /=nf90_noerr)THEN
450  WRITE(*,*)' 3rd ERROR READING ',trim(infile)
451  WRITE(*,*)trim(nf90_strerror(ierr))
452  WRITE(*,*)' Yer Out!'
453  stop
454  END IF
455  END IF
456  END IF
457 
458  !---------------------------------------------------------------------
459  ! Read Data from file INFILE at time level ht
460  !---------------------------------------------------------------------
461 
462  ! ----- ADDED BY JHC (04/07) TO GET time (SECONDS AFTER START TIME) OF EACH READ------
463 
464  n_times = getdim(nc_fid,len_trim('time'),'time') ! number of times in file
465 
466  ALLOCATE(temp(ht,1))
467 
468  CALL getsvar(nc_fid,len_trim('time'),'time',ht,1,temp)
469 
470 
471  time = temp(ht,1)
472  DEALLOCATE(temp)
473 
474  !--free surface elevation
475  ALLOCATE(temp(m,1))
476  CALL getdvar(nc_fid,len_trim('zeta'),'zeta',m,1,temp,ht)
477  ell(1:m) = temp(1:m,1)
478  DEALLOCATE(temp)
479 
480  !--salinity
481  !ALLOCATE(TEMP(M,KBM1))
482  !CALL GETDVAR(NC_FID,LEN_TRIM('salinity'),'salinity',M,KBM1,TEMP,HT)
483  !S1L(1:M,1:KBM1) = TEMP(1:M,1:KBM1)
484  !DEALLOCATE(TEMP)
485 
486  ! temperature
487  ! ALLOCATE(TEMP(M,KBM1))
488  ! CALL GETDVAR(NC_FID,LEN_TRIM('temp'),'temp',M,KBM1,TEMP,HT)
489  ! T1L(1:M,1:KBM1) = TEMP(1:M,1:KBM1)
490  ! DEALLOCATE(TEMP)
491 
492 
493  !--U velocity
494  ALLOCATE(temp(n,kbm1))
495  CALL getdvar(nc_fid,len_trim('u'),'u',n,kbm1,temp,ht)
496  ul(1:n,1:kbm1) = temp(1:n,1:kbm1)
497  DEALLOCATE(temp)
498 
499  !--V velocity
500  ALLOCATE(temp(n,kbm1))
501  CALL getdvar(nc_fid,len_trim('v'),'v',n,kbm1,temp,ht)
502  vl(1:n,1:kbm1) = temp(1:n,1:kbm1)
503  DEALLOCATE(temp)
504 !----------------------------here you have to check what name and format(node or cell) you output
505  !--WW velocity
506 ! ALLOCATE(TEMP(N,KBM1))
507 ! CALL GETDVAR(NC_FID,LEN_TRIM('ww'),'ww',N,KBM1,TEMP,HT)
508 ! WWL(1:N,1:KBM1) = TEMP(1:N,1:KBM1)
509 ! DEALLOCATE(TEMP)
510  !--W velocity (omega)
511  ALLOCATE(temp(m,kbm1))
512  ALLOCATE(temp2(n,kbm1))
513 print *, 'do not read omega, set to zero:'
514 temp=0.0
515 ! CALL GETDVAR(NC_FID,LEN_TRIM('omega'),'omega',M,KBM1,TEMP,HT) !original
516 ! CALL GETDVAR(NC_FID,LEN_TRIM('wts'),'wts',M,KBM1,TEMP,HT) !pengfei some case people output as wts, maybe from cell(N) or from node(M)
517  DO i = 1,n
518  temp2(i,:) = ((temp(nv(i,1),:))+(temp(nv(i,2),:))+(temp(nv(i,3),:)))/3.0
519  END DO
520  wwl(1:n,1:kbm1) = temp2(1:n,1:kbm1)
521  DEALLOCATE(temp,temp2)
522 
523  !--KH
524  ALLOCATE(temp(m,kbm1))
525 print *, 'do not read km, set to zero'
526 temp=0.0
527 ! CALL GETDVAR(NC_FID,LEN_TRIM('km'),'km',M,KBM1,TEMP,HT)
528  khl(1:m,1:kbm1) = temp(1:m,1:kbm1)
529  DEALLOCATE(temp)
530 
531  !--Close file
532  ierr = nf90_close(nc_fid)
533 
534  RETURN
535 END SUBROUTINE ncd_read
536 
537 !==============================================================================|
538 
539 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
540 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
541 
542 !==============================================================================|
543 ! MODIFIED BY JHC 04/07 TO OUTPUT SURFACE ELEVATION (EP) AND BOTTOM DEPTH (HP)
544 ! Modified by JHC 07/07 to include the inwater variable in the output NCD file
545 
546 !SUBROUTINE NCD_WRITE(INFILE,NPTS,TIME,LABEL,INDOMAIN,XP,YP,ZP,UP,VP,WP,NT)
547 SUBROUTINE ncd_write_el(INFILE,nnode,nlayer,temp)
549 IMPLICIT NONE
550  INTEGER, INTENT(IN) :: nnode,nlayer
551  CHARACTER(LEN=120), INTENT(IN) :: INFILE
552  CHARACTER(LEN=100) :: varname
553  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
554  INTEGER :: IERR,varid
555  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
556  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
557  INTEGER :: DYNMTIME(1)
558  INTEGER :: STAT1D(1),DYNM1D(2)
559  REAL(SP), DIMENSION(nnode,nlayer) :: TEMP
560  integer :: RecordDimID
561  integer :: nRecords
562  integer :: dims(2)
563  character(len = nf90_max_name) :: RecordDimName
564 
565  varname='zeta'
566 
567  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
568  IF(ierr /=nf90_noerr)THEN
569  WRITE(*,*)'ERROR OPENING ',trim(infile)
570  WRITE(*,*)trim(nf90_strerror(ierr))
571  stop
572  END IF
573  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
574  IF(ierr /=nf90_noerr)THEN
575  WRITE(*,*)'error inquire unlimited id for el: '
576  WRITE(*,*)trim(nf90_strerror(ierr))
577  stop
578  END IF
579  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
580  name = recorddimname, len = nrecords)
581  IF(ierr /=nf90_noerr)THEN
582  WRITE(*,*)'error inquire length of unlimited id for el: '
583  WRITE(*,*)trim(nf90_strerror(ierr))
584  stop
585  END IF
586  print *, "length of unlimited dimension are : ",nrecords
587  dims(1)=1
588  dims(2)=nrecords
589 
590 
591  !write time to file
592 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
593  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
594  IF(ierr /=nf90_noerr)THEN
595  WRITE(*,*)'error getting variable id: ',trim(varname)
596  WRITE(*,*)trim(nf90_strerror(ierr))
597  stop
598  END IF
599 
600  ierr = nf90_put_var(nc_fid,varid,temp,start=dims)
601  IF(ierr /=nf90_noerr)THEN
602  WRITE(*,*)'3 error getting variable: ',trim(varname)
603 ! print *, temp,dims ! should be mark
604  WRITE(*,*)trim(nf90_strerror(ierr))
605  stop
606  END IF
607  !--Close file
608  ierr = nf90_close(nc_fid)
609 END SUBROUTINE ncd_write_el
610 
611 SUBROUTINE ncd_write_u(INFILE,ncell,nlayer,temp)
613 IMPLICIT NONE
614  INTEGER, INTENT(IN) :: ncell,nlayer
615  CHARACTER(LEN=120), INTENT(IN) :: INFILE
616  CHARACTER(LEN=100) :: varname
617  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
618  INTEGER :: IERR,VARID
619  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
620  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
621  INTEGER :: DYNMTIME(1)
622  INTEGER :: STAT1D(1),DYNM1D(2)
623  REAL(SP), DIMENSION(ncell,nlayer) :: TEMP
624  REAL(SP), DIMENSION(ncell,nlayer,1) :: TEMP3
625  integer :: RecordDimID
626  integer :: nRecords
627  integer :: dims(3)
628  character(len = nf90_max_name) :: RecordDimName
629 ! temp3(:,:,1)=temp(:,:)
630  varname='u'
631  print *, 'open nc file in write u: ',trim(infile)
632  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
633  IF(ierr /=nf90_noerr)THEN
634  WRITE(*,*)'ERROR OPENING ',trim(infile)
635  WRITE(*,*)trim(nf90_strerror(ierr))
636  stop
637  END IF
638  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
639  IF(ierr /=nf90_noerr)THEN
640  WRITE(*,*)'error inquire unlimited id for u: '
641  WRITE(*,*)trim(nf90_strerror(ierr))
642  stop
643  END IF
644  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
645  name = recorddimname, len = nrecords)
646  IF(ierr /=nf90_noerr)THEN
647  WRITE(*,*)'error inquire length of unlimited id for u: '
648  WRITE(*,*)trim(nf90_strerror(ierr))
649  stop
650  END IF
651  print *, "length of unlimited dimension are : ",nrecords
652  dims(1)=1
653  dims(2)=1
654  dims(3)=nrecords
655 
656  !write time to file
657 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
658  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
659  IF(ierr /=nf90_noerr)THEN
660  WRITE(*,*)'error getting variable id: ',trim(varname)
661  WRITE(*,*)trim(nf90_strerror(ierr))
662  stop
663  END IF
664 
665  ierr = nf90_put_var(nc_fid,varid,temp,start=dims)
666  IF(ierr /=nf90_noerr)THEN
667  WRITE(*,*)'3 error getting variable: ',trim(varname)
668 ! print *, temp,dims ! should be mark
669  WRITE(*,*)trim(nf90_strerror(ierr))
670  stop
671  END IF
672  !--Close file
673  ierr = nf90_close(nc_fid)
674 
675 
676 
677 END SUBROUTINE ncd_write_u
678 
679 
680 SUBROUTINE ncd_write_v(INFILE,ncell,nlayer,temp)
682 IMPLICIT NONE
683  INTEGER, INTENT(IN) :: ncell,nlayer
684  CHARACTER(LEN=120), INTENT(IN) :: INFILE
685  CHARACTER(LEN=100) :: varname
686  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
687  INTEGER :: IERR,VARID
688  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
689  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
690  INTEGER :: DYNMTIME(1)
691  INTEGER :: STAT1D(1),DYNM1D(2)
692  REAL(SP), DIMENSION(ncell,nlayer) :: TEMP
693  integer :: RecordDimID
694  integer :: nRecords
695  integer :: dims(3)
696  character(len = nf90_max_name) :: RecordDimName
697  varname='v'
698 
699  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
700  IF(ierr /=nf90_noerr)THEN
701  WRITE(*,*)'ERROR OPENING ',trim(infile)
702  WRITE(*,*)trim(nf90_strerror(ierr))
703  stop
704  END IF
705 
706  !write time to file
707 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
708  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
709  IF(ierr /=nf90_noerr)THEN
710  WRITE(*,*)'error getting variable id: ',trim(varname)
711  WRITE(*,*)trim(nf90_strerror(ierr))
712  stop
713  END IF
714  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
715  IF(ierr /=nf90_noerr)THEN
716  WRITE(*,*)'error inquire unlimited id for v: '
717  WRITE(*,*)trim(nf90_strerror(ierr))
718  stop
719  END IF
720  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
721  name = recorddimname, len = nrecords)
722  IF(ierr /=nf90_noerr)THEN
723  WRITE(*,*)'error inquire length of unlimited id for v: '
724  WRITE(*,*)trim(nf90_strerror(ierr))
725  stop
726  END IF
727  print *, "length of unlimited dimension are : ",nrecords
728  dims(1)=1
729  dims(2)=1
730  dims(3)=nrecords
731 
732  ierr = nf90_put_var(nc_fid,varid,temp,start=dims)
733  IF(ierr /=nf90_noerr)THEN
734  WRITE(*,*)'3 error getting variable: ',trim(varname)
735 ! print *, temp,dims ! should be mark
736  WRITE(*,*)trim(nf90_strerror(ierr))
737  stop
738  END IF
739  !--Close file
740  ierr = nf90_close(nc_fid)
741 
742 
743 END SUBROUTINE ncd_write_v
744 
745 
746 
747 !#################################
748 SUBROUTINE ncd_write_u10(INFILE,ncell,nlayer,temp)
750 IMPLICIT NONE
751  INTEGER, INTENT(IN) :: ncell,nlayer
752  CHARACTER(LEN=120), INTENT(IN) :: INFILE
753  CHARACTER(LEN=100) :: varname
754  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
755  INTEGER :: IERR,VARID
756  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
757  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
758  INTEGER :: DYNMTIME(1)
759  INTEGER :: STAT1D(1),DYNM1D(2)
760  REAL(SP), DIMENSION(ncell,nlayer) :: TEMP
761  REAL(SP), DIMENSION(ncell,nlayer,1) :: TEMP3
762  integer :: num
763  integer :: RecordDimID
764  integer :: nRecords
765  integer :: dims(3),cnts(3)
766  character(len = nf90_max_name) :: RecordDimName
767 ! temp3(:,:,1)=temp(:,:)
768  num=10
769  varname='u'
770  print *, 'open nc file in write u: ',trim(infile)
771  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
772  IF(ierr /=nf90_noerr)THEN
773  WRITE(*,*)'ERROR OPENING ',trim(infile)
774  WRITE(*,*)trim(nf90_strerror(ierr))
775  stop
776  END IF
777  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
778  IF(ierr /=nf90_noerr)THEN
779  WRITE(*,*)'error inquire unlimited id for u: '
780  WRITE(*,*)trim(nf90_strerror(ierr))
781  stop
782  END IF
783  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
784  name = recorddimname, len = nrecords)
785  IF(ierr /=nf90_noerr)THEN
786  WRITE(*,*)'error inquire length of unlimited id for u: '
787  WRITE(*,*)trim(nf90_strerror(ierr))
788  stop
789  END IF
790  print *, "length of unlimited dimension are : ",nrecords
791  dims(1)=1
792  dims(2)=1
793  dims(3)=nrecords
794  cnts(1)=ncell
795  cnts(2)=num
796  cnts(3)=1
797 
798  !write time to file
799 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
800  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
801  IF(ierr /=nf90_noerr)THEN
802  WRITE(*,*)'error getting variable id: ',trim(varname)
803  WRITE(*,*)trim(nf90_strerror(ierr))
804  stop
805  END IF
806 
807  ierr = nf90_put_var(nc_fid,varid,temp(:,1:num),start=dims,count=cnts)
808  IF(ierr /=nf90_noerr)THEN
809  WRITE(*,*)'3 error getting variable: ',trim(varname)
810 ! print *, temp,dims ! should be mark
811  WRITE(*,*)trim(nf90_strerror(ierr))
812  stop
813  END IF
814  !--Close file
815  ierr = nf90_close(nc_fid)
816 
817 
818 
819 END SUBROUTINE ncd_write_u10
820 
821 
822 SUBROUTINE ncd_write_v10(INFILE,ncell,nlayer,temp)
824 IMPLICIT NONE
825  INTEGER, INTENT(IN) :: ncell,nlayer
826  CHARACTER(LEN=120), INTENT(IN) :: INFILE
827  CHARACTER(LEN=100) :: varname
828  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
829  INTEGER :: IERR,VARID
830  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
831  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
832  INTEGER :: DYNMTIME(1)
833  INTEGER :: STAT1D(1),DYNM1D(2)
834  REAL(SP), DIMENSION(ncell,nlayer) :: TEMP
835  integer :: num
836  integer :: RecordDimID
837  integer :: nRecords
838  integer :: dims(3),cnts(3)
839  character(len = nf90_max_name) :: RecordDimName
840  varname='v'
841  num=10
842  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
843  IF(ierr /=nf90_noerr)THEN
844  WRITE(*,*)'ERROR OPENING ',trim(infile)
845  WRITE(*,*)trim(nf90_strerror(ierr))
846  stop
847  END IF
848 
849  !write time to file
850 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
851  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
852  IF(ierr /=nf90_noerr)THEN
853  WRITE(*,*)'error getting variable id: ',trim(varname)
854  WRITE(*,*)trim(nf90_strerror(ierr))
855  stop
856  END IF
857  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
858  IF(ierr /=nf90_noerr)THEN
859  WRITE(*,*)'error inquire unlimited id for v: '
860  WRITE(*,*)trim(nf90_strerror(ierr))
861  stop
862  END IF
863  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
864  name = recorddimname, len = nrecords)
865  IF(ierr /=nf90_noerr)THEN
866  WRITE(*,*)'error inquire length of unlimited id for v: '
867  WRITE(*,*)trim(nf90_strerror(ierr))
868  stop
869  END IF
870  print *, "length of unlimited dimension are : ",nrecords
871  dims(1)=1
872  dims(2)=1
873  dims(3)=nrecords
874  cnts(1)=ncell
875  cnts(2)=num
876  cnts(3)=1
877 
878  ierr = nf90_put_var(nc_fid,varid,temp(:,1:num),start=dims,count=cnts)
879  IF(ierr /=nf90_noerr)THEN
880  WRITE(*,*)'3 error getting variable: ',trim(varname)
881 ! print *, temp,dims ! should be mark
882  WRITE(*,*)trim(nf90_strerror(ierr))
883  stop
884  END IF
885  !--Close file
886  ierr = nf90_close(nc_fid)
887 
888 
889 END SUBROUTINE ncd_write_v10
890 
891 
892 !################################
893 
894 
895 SUBROUTINE ncd_write_t(INFILE,nnode,nlayer,temp)
897 IMPLICIT NONE
898  INTEGER, INTENT(IN) :: nnode,nlayer
899  CHARACTER(LEN=120), INTENT(IN) :: INFILE
900  CHARACTER(LEN=100) :: varname
901  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
902  INTEGER :: IERR,VARID
903  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
904  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
905  INTEGER :: DYNMTIME(1)
906  INTEGER :: STAT1D(1),DYNM1D(2)
907  REAL(SP), DIMENSION(nnode,nlayer) :: TEMP
908  integer :: RecordDimID
909  integer :: nRecords
910  integer :: dims(3)
911  character(len = nf90_max_name) :: RecordDimName
912 
913  varname='temp'
914 
915  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
916  IF(ierr /=nf90_noerr)THEN
917  WRITE(*,*)'ERROR OPENING ',trim(infile)
918  WRITE(*,*)trim(nf90_strerror(ierr))
919  stop
920  END IF
921 
922  !write time to file
923 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
924  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
925  IF(ierr /=nf90_noerr)THEN
926  WRITE(*,*)'error getting variable id: ',trim(varname)
927  WRITE(*,*)trim(nf90_strerror(ierr))
928  stop
929  END IF
930  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
931  IF(ierr /=nf90_noerr)THEN
932  WRITE(*,*)'error inquire unlimited id for t: '
933  WRITE(*,*)trim(nf90_strerror(ierr))
934  stop
935  END IF
936  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
937  name = recorddimname, len = nrecords)
938  IF(ierr /=nf90_noerr)THEN
939  WRITE(*,*)'error inquire length of unlimited id for t: '
940  WRITE(*,*)trim(nf90_strerror(ierr))
941  stop
942  END IF
943  print *, "length of unlimited dimension are : ",nrecords
944  dims(1)=1
945  dims(2)=1
946  dims(3)=nrecords
947  ierr = nf90_put_var(nc_fid,varid,temp,start=dims)
948  IF(ierr /=nf90_noerr)THEN
949  WRITE(*,*)'3 error getting variable: ',trim(varname)
950 ! print *, temp,dims ! should be mark
951  WRITE(*,*)trim(nf90_strerror(ierr))
952  stop
953  END IF
954  !--Close file
955  ierr = nf90_close(nc_fid)
956 END SUBROUTINE ncd_write_t
957 
958 
959 SUBROUTINE ncd_write_s(INFILE,nnode,nlayer,temp)
961 IMPLICIT NONE
962  INTEGER, INTENT(IN) ::nnode,nlayer
963  CHARACTER(LEN=120), INTENT(IN) :: INFILE
964  CHARACTER(LEN=100) :: varname
965  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
966  INTEGER :: IERR,VARID
967  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
968  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
969  INTEGER :: DYNMTIME(1)
970  INTEGER :: STAT1D(1),DYNM1D(2)
971  REAL(SP), DIMENSION(nnode,nlayer) :: TEMP
972  integer :: RecordDimID
973  integer :: nRecords
974  integer :: dims(3)
975  character(len = nf90_max_name) :: RecordDimName
976 
977  varname='salinity'
978 
979  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
980  IF(ierr /=nf90_noerr)THEN
981  WRITE(*,*)'ERROR OPENING ',trim(infile)
982  WRITE(*,*)trim(nf90_strerror(ierr))
983  stop
984  END IF
985 
986  !write time to file
987 ! CALL PUTDVAR(NC_FID,LEN_TRIM('time'),'time',1,TEMP,NT)
988  ierr = nf90_inq_varid(nc_fid,trim(varname),varid)
989  IF(ierr /=nf90_noerr)THEN
990  WRITE(*,*)'error getting variable id: ',trim(varname)
991  WRITE(*,*)trim(nf90_strerror(ierr))
992  stop
993  END IF
994 
995  ierr = nf90_inquire(nc_fid, unlimiteddimid = recorddimid)
996  IF(ierr /=nf90_noerr)THEN
997  WRITE(*,*)'error inquire unlimited id for s: '
998  WRITE(*,*)trim(nf90_strerror(ierr))
999  stop
1000  END IF
1001  ierr = nf90_inquire_dimension(nc_fid, recorddimid, &
1002  name = recorddimname, len = nrecords)
1003  IF(ierr /=nf90_noerr)THEN
1004  WRITE(*,*)'error inquire length of unlimited id for s: '
1005  WRITE(*,*)trim(nf90_strerror(ierr))
1006  stop
1007  END IF
1008  print *, "length of unlimited dimension are : ",nrecords
1009  dims(1)=1
1010  dims(2)=1
1011  dims(3)=nrecords
1012 
1013 
1014 
1015  ierr = nf90_put_var(nc_fid,varid,temp,start=dims)
1016  IF(ierr /=nf90_noerr)THEN
1017  WRITE(*,*)'3 error getting variable: ',trim(varname)
1018 ! print *, temp,dims ! should be mark
1019  WRITE(*,*)trim(nf90_strerror(ierr))
1020  stop
1021  END IF
1022  !--Close file
1023  ierr = nf90_close(nc_fid)
1024 END SUBROUTINE ncd_write_s
1025 
1026 
1027 
1028 
1029 
1030 
1031 
1032 
1033 
1034 
1035 
1036 
1037 
1038 !=======================================================================================
1039 SUBROUTINE ncd_write(INFILE,NPTS,TIME,LABEL,INDOMAIN,XP,YP,ZP,UP,VP,WP,EP,HP,INWATER,NT)
1041  USE mod_ncd
1042  IMPLICIT NONE
1043  !----------------------------------------------------------------------------!
1044  INTEGER, INTENT(IN) :: NPTS, NT
1045  INTEGER, DIMENSION(NPTS),INTENT(IN) :: LABEL,INDOMAIN,INWATER ! 07/07 ADDED INWATER
1046  REAL(SP), DIMENSION(NPTS),INTENT(IN) :: XP,YP,ZP,UP,VP,WP,EP,HP ! 04/07 ADDED EP & HP
1047  REAL(SP), INTENT(IN) :: TIME
1048  CHARACTER(LEN=100), INTENT(IN) :: INFILE
1049  !----------------------------------------------------------------------------!
1050  CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
1051  INTEGER :: IERR
1052  INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
1053  INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
1054  INTEGER :: DYNMTIME(1)
1055  INTEGER :: STAT1D(1),DYNM1D(2)
1056  REAL(SP), ALLOCATABLE, DIMENSION(:) :: TEMP
1057  !----------------------------------------------------------------------------!
1058 
1059  IF(nt == 1)THEN
1060 
1061  !--Create File --> nc_fid (modified by JHC 4/07 to allow for input of file into MATLAB)
1062  ierr = nf90_create(trim(infile) ,nf90_clobber, nc_fid)
1063  IF(ierr /=nf90_noerr)THEN
1064  WRITE(*,*)'error creating',trim(infile)
1065  WRITE(*,*)trim(nf90_strerror(ierr))
1066  stop
1067  END IF
1068 
1069  !--Netcdf Convention String
1070  netcdf_convention = 'CF-1.0'
1071 
1072  !Global Attributes
1073  tstring = "FVCOM Offline Lagrangian Particle Data"
1074  ierr = nf90_put_att(nc_fid,nf90_global,"title",tstring)
1075  ierr = nf90_put_att(nc_fid,nf90_global,"institution","SMAST")
1076  ierr = nf90_put_att(nc_fid,nf90_global,"source" ,"OFFLINE_FVCOM")
1077  ierr = nf90_put_att(nc_fid,nf90_global,"modeler" ,"PHIL MCCRACKEN")
1078  ierr = nf90_put_att(nc_fid,nf90_global,"Conventions",trim(netcdf_convention))
1079 
1080  !Dimensioning
1081  ierr = nf90_def_dim(nc_fid,"nlag" ,npts,nlag_did)
1082  ierr = nf90_def_dim(nc_fid,"time" ,nf90_unlimited,time_did)
1083 
1084  dynmtime = (/time_did/) !!Time
1085  dynm1d = (/nlag_did,time_did/) !!Dynamic 1d var
1086  stat1d = (/nlag_did/) !!Static 1d var
1087  !--Variable Definitions
1088 
1089  !!====time===============================================!
1090  ierr = nf90_def_var(nc_fid,"time",nf90_float,dynmtime,time_vid)
1091  ierr = nf90_put_att(nc_fid,time_vid,"long_name","time")
1092  ierr = nf90_put_att(nc_fid,time_vid,"units","seconds")
1093 
1094  !!=====label==============================================!
1095  ierr = nf90_def_var(nc_fid,"label",nf90_float,stat1d,lab_vid)
1096  ierr = nf90_put_att(nc_fid,lab_vid,"long_name","particle label")
1097  ierr = nf90_put_att(nc_fid,lab_vid,"units","")
1098 
1099  !!=====indomain=================================================!
1100  ierr = nf90_def_var(nc_fid,"indomain",nf90_float,dynm1d,ind_vid)
1101  ierr = nf90_put_att(nc_fid,ind_vid,"long_name","particle indomain (1)")
1102  ierr = nf90_put_att(nc_fid,ind_vid,"units","")
1103  !!=====x=================================================!
1104  ierr = nf90_def_var(nc_fid,"x",nf90_float,dynm1d,x_vid)
1105  ierr = nf90_put_att(nc_fid,x_vid,"long_name","particle x position")
1106  ierr = nf90_put_att(nc_fid,x_vid,"units","m")
1107 
1108  !!=====y=================================================!
1109  ierr = nf90_def_var(nc_fid,"y",nf90_float,dynm1d,y_vid)
1110  ierr = nf90_put_att(nc_fid,y_vid,"long_name","particle y position")
1111  ierr = nf90_put_att(nc_fid,y_vid,"units","m")
1112 
1113  !!=====z=================================================!
1114  ierr = nf90_def_var(nc_fid,"z",nf90_float,dynm1d,z_vid)
1115  ierr = nf90_put_att(nc_fid,z_vid,"long_name","particle z position")
1116  ierr = nf90_put_att(nc_fid,z_vid,"units","m")
1117 
1118  !!=====u=================================================!
1119  ierr = nf90_def_var(nc_fid,"u",nf90_float,dynm1d,u_vid)
1120  ierr = nf90_put_att(nc_fid,u_vid,"long_name","particle u velocity")
1121  ierr = nf90_put_att(nc_fid,u_vid,"units","cm/s")
1122 
1123  !!=====v=================================================!
1124  ierr = nf90_def_var(nc_fid,"v",nf90_float,dynm1d,v_vid)
1125  ierr = nf90_put_att(nc_fid,v_vid,"long_name","particle v velocity")
1126  ierr = nf90_put_att(nc_fid,v_vid,"units","cm/s")
1127 
1128  !!=====w=================================================!
1129  ierr = nf90_def_var(nc_fid,"omega",nf90_float,dynm1d,w_vid)
1130  ierr = nf90_put_att(nc_fid,w_vid,"long_name","particle w velocity")
1131  ierr = nf90_put_att(nc_fid,w_vid,"units","mm/s")
1132 
1133  ! ADDED BY JCH 04/07 TO OUTPUT SURFACE ELEVATION AND BOTTOM DEPTH
1134  !!=====elev=============================================!
1135  ierr = nf90_def_var(nc_fid,"elev",nf90_float,dynm1d,w_vid)
1136  ierr = nf90_put_att(nc_fid,w_vid,"long_name","surface elevation above particle")
1137  ierr = nf90_put_att(nc_fid,w_vid,"units","m")
1138  !!=====depth============================================!
1139  ierr = nf90_def_var(nc_fid,"depth",nf90_float,dynm1d,w_vid)
1140  ierr = nf90_put_att(nc_fid,w_vid,"long_name","bottom depth at particle")
1141  ierr = nf90_put_att(nc_fid,w_vid,"units","m")
1142 
1143  ! ADDED BY JCH 07/07 TO OUTPUT INWATER
1144  ierr = nf90_def_var(nc_fid,"inwater",nf90_float,dynm1d,ind_vid)
1145  ierr = nf90_put_att(nc_fid,ind_vid,"long_name","particle inwater (1)")
1146  ierr = nf90_put_att(nc_fid,ind_vid,"units","")
1147 
1148 
1149 
1150  ! END ADDITION
1151  !--End definition section
1152  ierr = nf90_enddef(nc_fid)
1153 
1154  !--Write Particle label
1155  ALLOCATE(temp(npts))
1156  temp(:) = float(label(:))
1157  CALL putsvar(nc_fid,len_trim('label'),'label',npts,temp)
1158  DEALLOCATE(temp)
1159 
1160  !--Close file
1161  ierr = nf90_close(nc_fid)
1162 
1163  ENDIF
1164 
1165  ierr = nf90_open(trim(infile),nf90_write,nc_fid)
1166  IF(ierr /=nf90_noerr)THEN
1167  WRITE(*,*)'ERROR OPENING ',trim(infile)
1168  WRITE(*,*)trim(nf90_strerror(ierr))
1169  stop
1170  END IF
1171 
1172  !write time to file
1173  ALLOCATE(temp(1))
1174  temp(1)=time
1175  CALL putdvar(nc_fid,len_trim('time'),'time',1,temp,nt)
1176  DEALLOCATE(temp)
1177 
1178  !write indomain to file
1179  ALLOCATE(temp(npts))
1180  temp(:) = float(indomain(:))
1181  CALL putdvar(nc_fid,len_trim('indomain'),'indomain',npts,temp,nt)
1182  DEALLOCATE(temp)
1183 
1184  !write position and velocity to file
1185  CALL putdvar(nc_fid,len_trim('x'),'x',npts,xp,nt)
1186  CALL putdvar(nc_fid,len_trim('y'),'y',npts,yp,nt)
1187  CALL putdvar(nc_fid,len_trim('z'),'z',npts,zp,nt)
1188  CALL putdvar(nc_fid,len_trim('u'),'u',npts,up,nt)
1189  CALL putdvar(nc_fid,len_trim('v'),'v',npts,vp,nt)
1190  CALL putdvar(nc_fid,len_trim('omega'),'omega',npts,wp,nt)
1191 
1192  ! ADDED BY JHC 04/07 TO WRITE SURFACE ELEVATION AND BOTTOM DEPTH TO FILE
1193  CALL putdvar(nc_fid,len_trim('elev'),'elev',npts,ep,nt)
1194  CALL putdvar(nc_fid,len_trim('depth'),'depth',npts,hp,nt)
1195 
1196  ! ADDED BY JCH 07/07 TO OUTPUT INWATER
1197  ALLOCATE(temp(npts))
1198  temp(:) = float(inwater(:))
1199  CALL putdvar(nc_fid,len_trim('inwater'),'inwater',npts,temp,nt)
1200  DEALLOCATE(temp)
1201 
1202  ! END ADDITION
1203 
1204  !close file
1205  ierr = nf90_close(nc_fid)
1206 ! write(*,'(i4)') IERR
1207 END SUBROUTINE ncd_write
subroutine getdvar(FID, NLEN, VARNAME, I1, I2, TEMP, NT)
subroutine ncd_read_grid(INFILE)
Definition: enkf_ncdio.f90:50
real(sp), dimension(:), allocatable, target h
Definition: mod_main.f90:1131
subroutine ncd_read_enkf(INFILE, UL, VL, T1L, S1L, ELL, HO)
Definition: enkf_ncdio.f90:263
subroutine putsvar(FID, NLEN, VARNAME, I1, TEMP)
subroutine getsvar(FID, NLEN, VARNAME, I1, I2, TEMP)
subroutine ncd_write_v(INFILE, ncell, nlayer, temp)
Definition: enkf_ncdio.f90:681
real(sp), dimension(:,:), allocatable, target dzz1
Definition: mod_main.f90:1097
real(sp), dimension(:,:), allocatable, target a1u
Definition: mod_main.f90:1331
subroutine ncd_write_t(INFILE, nnode, nlayer, temp)
Definition: enkf_ncdio.f90:896
real(sp), dimension(:,:), allocatable, target awx
Definition: mod_main.f90:1333
integer m
Definition: mod_main.f90:56
real(sp), dimension(:,:), allocatable, target aw0
Definition: mod_main.f90:1335
real(sp), dimension(:,:), allocatable, target awy
Definition: mod_main.f90:1334
real(sp), dimension(:), allocatable, target vx
Definition: mod_main.f90:1001
subroutine getsvar_d(FID, NLEN, VARNAME, I1, I2, TEMP)
integer kb
Definition: mod_main.f90:64
integer kbm2
Definition: mod_main.f90:66
subroutine ncd_write_s(INFILE, nnode, nlayer, temp)
Definition: enkf_ncdio.f90:960
integer n
Definition: mod_main.f90:55
real(sp), dimension(:), allocatable, target vy
Definition: mod_main.f90:1002
subroutine ncd_write_u10(INFILE, ncell, nlayer, temp)
Definition: enkf_ncdio.f90:749
subroutine ncd_write_el(INFILE, nnode, nlayer, temp)
Definition: enkf_ncdio.f90:548
integer, dimension(:,:), allocatable, target nv
Definition: mod_main.f90:1018
subroutine ncd_write_v10(INFILE, ncell, nlayer, temp)
Definition: enkf_ncdio.f90:823
subroutine ncd_read(INFILE, UL, VL, WWL, KHL, ELL, time, HO)
Definition: enkf_ncdio.f90:407
real(sp), dimension(:,:), allocatable, target zz1
Definition: mod_main.f90:1095
integer mgl
Definition: mod_main.f90:50
real(sp), dimension(:,:), allocatable, target dzz
Definition: mod_main.f90:1093
subroutine putdvar(FID, NLEN, VARNAME, I1, TEMP, NT)
real(sp), dimension(:,:), allocatable, target dz
Definition: mod_main.f90:1092
integer nc_fid
subroutine ncd_find_read_time_enkf(INFILE, Time, HO)
Definition: enkf_ncdio.f90:206
integer function getdim(FID, SSIZE, DIMNAME)
real(sp), dimension(:,:), allocatable, target a2u
Definition: mod_main.f90:1332
real(sp), dimension(:,:), allocatable, target z
Definition: mod_main.f90:1090
real(sp), dimension(:,:), allocatable, target dz1
Definition: mod_main.f90:1096
real(sp), dimension(:,:), allocatable, target z1
Definition: mod_main.f90:1094
subroutine ncd_read_shape(INFILE)
Definition: enkf_ncdio.f90:98
subroutine ncd_write(INFILE, NPTS, TIME, LABEL, INDOMAIN, XP, YP, ZP, UP, VP, WP, EP, HP, INWATER, NT)
integer kbm1
Definition: mod_main.f90:65
subroutine ncd_write_u(INFILE, ncell, nlayer, temp)
Definition: enkf_ncdio.f90:612
real(sp), dimension(:,:), allocatable, target zz
Definition: mod_main.f90:1091
integer ngl
Definition: mod_main.f90:49