My Project
mod_enkf_ncd.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 !==============================================================================|
40 ! NCD UTILITIES !
41 !==============================================================================|
42 
43 MODULE mod_ncd
44 
45  USE netcdf
46  USE mod_prec
47  IMPLICIT NONE
48  SAVE
49 
50  INTEGER :: nc_fid
51 
52 
53 CONTAINS
54  !==============================================================================!
55  INTEGER FUNCTION getdim(FID,SSIZE,DIMNAME)
56  !==============================================================================!
57  ! Read dimensions
58  !==============================================================================!
59 
60  IMPLICIT NONE
61  INTEGER, INTENT(IN) :: fid
62  INTEGER, INTENT(IN) :: ssize
63  CHARACTER(LEN=SSIZE), INTENT(IN) :: dimname
64  INTEGER :: length
65  INTEGER :: ierr
66  INTEGER :: dimid
67  CHARACTER(LEN=NF90_MAX_NAME) :: tempname
68 
69  ierr = nf90_inq_dimid(fid,trim(dimname),dimid)
70  IF(ierr /=nf90_noerr)THEN
71  WRITE(*,*)'Error getting dimension id: ',trim(dimname)
72  WRITE(*,*)trim(nf90_strerror(ierr))
73  stop
74  END IF
75 
76  ierr = nf90_inquire_dimension(fid,dimid,tempname,length)
77  IF(ierr /=nf90_noerr)THEN
78  WRITE(*,*)'Error getting dimension: ',trim(dimname)
79  WRITE(*,*)trim(nf90_strerror(ierr))
80  stop
81  END IF
82 
83  getdim = length
84 
85  END FUNCTION getdim
86  !==============================================================================!
87 
88  !==============================================================================!
89  SUBROUTINE getsvar(FID,NLEN,VARNAME,I1,I2,TEMP)
90  !============================================================================!
91  ! Read Static variables
92  !==============================================================================!
93 
94  IMPLICIT NONE
95  INTEGER, INTENT(IN) :: FID
96  INTEGER, INTENT(IN) :: NLEN
97  CHARACTER(LEN=NLEN), INTENT(IN) :: VARNAME
98  INTEGER, INTENT(IN) :: I1,I2
99  REAL(SP),INTENT(OUT) :: TEMP(I1,I2)
100  INTEGER :: IERR
101  INTEGER :: VARID
102  INTEGER, ALLOCATABLE :: DIMS(:)
103 
104  IF(i2 == 1)THEN
105  ALLOCATE(dims(1))
106  dims(1) = 1
107  ELSE
108  ALLOCATE(dims(2))
109  dims(1) = 1
110  dims(2) = 1
111  END IF
112 
113  ierr = nf90_inq_varid(fid,trim(varname),varid)
114  IF(ierr /=nf90_noerr)THEN
115  WRITE(*,*)'error getting variable id: ',trim(varname)
116  WRITE(*,*)trim(nf90_strerror(ierr))
117  stop
118  END IF
119 
120  ierr = nf90_get_var(fid,varid,temp,dims)
121  IF(ierr /=nf90_noerr)THEN
122  WRITE(*,*)'1 error getting variable: ',trim(varname)
123  WRITE(*,*)trim(nf90_strerror(ierr))
124  stop
125  END IF
126 
127  RETURN
128  END SUBROUTINE getsvar
129  !==============================================================================!
130 
131  !==============================================================================!
132  SUBROUTINE getsvar_d(FID,NLEN,VARNAME,I1,I2,TEMP)
133  !============================================================================!
134  ! Read Static variables
135  !==============================================================================!
136 
137  IMPLICIT NONE
138  INTEGER, INTENT(IN) :: FID
139  INTEGER, INTENT(IN) :: NLEN
140  CHARACTER(LEN=NLEN), INTENT(IN) :: VARNAME
141  INTEGER, INTENT(IN) :: I1,I2
142  REAL(DP),INTENT(OUT) :: TEMP(I1,I2)
143  INTEGER :: IERR
144  INTEGER :: VARID
145  INTEGER, ALLOCATABLE :: DIMS(:)
146 
147  IF(i2 == 1)THEN
148  ALLOCATE(dims(1))
149  dims(1) = 1
150  ELSE
151  ALLOCATE(dims(2))
152  dims(1) = 1
153  dims(2) = 1
154  END IF
155 
156  ierr = nf90_inq_varid(fid,trim(varname),varid)
157  IF(ierr /=nf90_noerr)THEN
158  WRITE(*,*)'error getting variable id: ',trim(varname)
159  WRITE(*,*)trim(nf90_strerror(ierr))
160  stop
161  END IF
162 
163  ierr = nf90_get_var(fid,varid,temp,dims)
164  IF(ierr /=nf90_noerr)THEN
165  WRITE(*,*)'1 error getting variable: ',trim(varname)
166  WRITE(*,*)trim(nf90_strerror(ierr))
167  stop
168  END IF
169 
170  RETURN
171  END SUBROUTINE getsvar_d
172  !==============================================================================!
173 
174  !==============================================================================!
175  SUBROUTINE getdvar(FID,NLEN,VARNAME,I1,I2,TEMP,NT)
176  !============================================================================!
177  ! Read time dynamic variables
178  !==============================================================================!
179 
180  IMPLICIT NONE
181  INTEGER, INTENT(IN) :: FID
182  INTEGER, INTENT(IN) :: NLEN
183  CHARACTER(LEN=NLEN), INTENT(IN) :: VARNAME
184  INTEGER, INTENT(IN) :: I1,I2
185  REAL(SP), INTENT(OUT) :: TEMP(I1,I2)
186  INTEGER :: IERR
187  INTEGER :: VARID
188  INTEGER :: NT
189  INTEGER, ALLOCATABLE :: DIMS(:)
190 
191  IF(i2 == 1)THEN
192  ALLOCATE(dims(2))
193  dims(1) = 1
194  dims(2) = nt
195  ELSE
196  ALLOCATE(dims(3))
197  dims(1) = 1
198  dims(2) = 1
199  dims(3) = nt
200  END IF
201 
202  ierr = nf90_inq_varid(fid,trim(varname),varid)
203  IF(ierr /=nf90_noerr)THEN
204  WRITE(*,*)'error getting variable id: ',trim(varname)
205  WRITE(*,*)trim(nf90_strerror(ierr))
206  stop
207  END IF
208 
209  ierr = nf90_get_var(fid,varid,temp,dims)
210  IF(ierr /=nf90_noerr)THEN
211  WRITE(*,*)'2 error getting variable: ',trim(varname)
212  WRITE(*,*)trim(nf90_strerror(ierr))
213  stop
214  END IF
215 
216  RETURN
217  END SUBROUTINE getdvar
218  !==============================================================================!
219 
220  !==============================================================================!
221  SUBROUTINE putdvar(FID,NLEN,VARNAME,I1,TEMP,NT)
222  !============================================================================!
223  ! Write dynamic time variables
224  !==============================================================================!
225 
226  IMPLICIT NONE
227  INTEGER, INTENT(IN) :: FID
228  INTEGER, INTENT(IN) :: NLEN
229  CHARACTER(LEN=NLEN), INTENT(IN) :: VARNAME
230  INTEGER, INTENT(IN) :: I1
231  REAL(SP),INTENT(IN) :: TEMP(I1)
232  INTEGER :: IERR
233  INTEGER :: VARID
234  INTEGER, ALLOCATABLE :: DIMS(:)
235  INTEGER :: NT
236 
237  IF(i1 == 1)THEN
238  ALLOCATE(dims(1))
239  dims(1) = nt
240  ELSE
241  ALLOCATE(dims(2))
242  dims(1) = 1
243  dims(2) = nt
244  END IF
245 
246  ierr = nf90_inq_varid(fid,trim(varname),varid)
247  IF(ierr /=nf90_noerr)THEN
248  WRITE(*,*)'error getting variable id: ',trim(varname)
249  WRITE(*,*)trim(nf90_strerror(ierr))
250  stop
251  END IF
252 
253  ierr = nf90_put_var(fid,varid,temp,dims)
254  IF(ierr /=nf90_noerr)THEN
255  WRITE(*,*)'3 error getting variable: ',trim(varname)
256  print *, temp,dims ! should be mark
257  WRITE(*,*)trim(nf90_strerror(ierr))
258  stop
259  END IF
260 
261  RETURN
262  END SUBROUTINE putdvar
263  !==============================================================================!
264 
265  !==============================================================================!
266  SUBROUTINE putsvar(FID,NLEN,VARNAME,I1,TEMP)
267  !============================================================================!
268  ! Write static variables
269  !==============================================================================!
270 
271  IMPLICIT NONE
272  INTEGER, INTENT(IN) :: FID
273  INTEGER, INTENT(IN) :: NLEN
274  CHARACTER(LEN=NLEN), INTENT(IN) :: VARNAME
275  INTEGER, INTENT(IN) :: I1
276  REAL(SP), INTENT(IN) :: TEMP(I1)
277  INTEGER :: IERR
278  INTEGER :: VARID
279  INTEGER, DIMENSION(1) :: DIMS
280 
281  dims(1)=1
282 
283  ierr = nf90_inq_varid(fid,trim(varname),varid)
284  IF(ierr /=nf90_noerr)THEN
285  WRITE(*,*)'error getting variable id: ',trim(varname)
286  WRITE(*,*)trim(nf90_strerror(ierr))
287  stop
288  END IF
289 
290  ierr = nf90_put_var(fid,varid,temp,dims)
291  IF(ierr /=nf90_noerr)THEN
292  WRITE(*,*)'4 error getting variable: ',trim(varname)
293  WRITE(*,*)trim(nf90_strerror(ierr))
294  stop
295  END IF
296 
297  RETURN
298  END SUBROUTINE putsvar
299  !==============================================================================!
300 
301 END MODULE mod_ncd
mod_ncd::getdvar
subroutine getdvar(FID, NLEN, VARNAME, I1, I2, TEMP, NT)
Definition: mod_enkf_ncd.f90:176
mod_ncd::putsvar
subroutine putsvar(FID, NLEN, VARNAME, I1, TEMP)
Definition: mod_enkf_ncd.f90:267
mod_ncd::getsvar
subroutine getsvar(FID, NLEN, VARNAME, I1, I2, TEMP)
Definition: mod_enkf_ncd.f90:90
mod_ncd
Definition: mod_enkf_ncd.f90:43
mod_prec
Definition: mod_prec.f90:43
mod_ncd::getsvar_d
subroutine getsvar_d(FID, NLEN, VARNAME, I1, I2, TEMP)
Definition: mod_enkf_ncd.f90:133
mod_ncd::putdvar
subroutine putdvar(FID, NLEN, VARNAME, I1, TEMP, NT)
Definition: mod_enkf_ncd.f90:222
mod_ncd::nc_fid
integer nc_fid
Definition: mod_enkf_ncd.f90:50
mod_ncd::getdim
integer function getdim(FID, SSIZE, DIMNAME)
Definition: mod_enkf_ncd.f90:56
Generated by   doxygen 1.8.15