fvcom_tools 1.14.0
Loading...
Searching...
No Matches
module_nwp.f90
Go to the documentation of this file.
1
4
15module module_nwp
16
17 use kinds, only: r_kind, r_single, i_short, rmissing
18! use module_map_utils, only: map_util
19 use module_ncio, only: ncio
20
21 implicit none
22
23 public :: fcst_nwp
24
25 private
26 type :: fcst_nwp
27 character(len=6) :: datatype
28 integer :: numvar
29 integer :: xlat
30 integer :: xlon
31 integer :: xtime
32 integer :: datelen
33 integer :: i_mask
34 integer :: i_sst
35 integer :: i_ice
36 integer :: i_sfct
37 integer :: i_icet
38 integer :: i_sfctl
39 integer :: i_zorl
40 integer :: i_hice
41 character(len=20), allocatable :: varnames(:)
42 character(len=20), allocatable :: latname
43 character(len=20), allocatable :: lonname
44 character(len=20), allocatable :: dimnameew
45 character(len=20), allocatable :: dimnamens
46 character(len=20), allocatable :: dimnametime
47 character(len=20), allocatable :: dimnamedate
48 character(len=1), allocatable :: times(:,:)
49
50 real(r_single), allocatable :: nwp_mask_c(:,:)
51 real(r_single), allocatable :: nwp_sst_c(:,:,:)
52 real(r_single), allocatable :: nwp_ice_c(:,:,:)
53 real(r_single), allocatable :: nwp_sfct_c(:,:,:)
54 real(r_single), allocatable :: nwp_icet_c(:,:,:)
55 real(r_single), allocatable :: nwp_zorl_c(:,:,:)
56 real(r_single), allocatable :: nwp_hice_c(:,:,:)
57
58 real(r_single), allocatable :: nwp_mask_w(:,:)
59 real(r_single), allocatable :: nwp_sst_w(:,:)
60 real(r_single), allocatable :: nwp_ice_w(:,:)
61 real(r_single), allocatable :: nwp_sfct_w(:,:)
62 real(r_single), allocatable :: nwp_icet_w(:,:)
63 real(r_single), allocatable :: nwp_sfctl_w(:,:)
64 real(r_single), allocatable :: nwp_zorl_w(:,:)
65 real(r_single), allocatable :: nwp_hice_w(:,:)
66
67 contains
68 procedure :: initial => initial_nwp
69 procedure :: list_initial => list_initial_nwp
70 procedure :: read_n => read_nwp
71 procedure :: get_time_ind => get_time_ind_nwp
72 procedure :: finish => finish_nwp
73 end type fcst_nwp
74
75 type(ncio) :: ncdata
76! type(map_util) :: map
77
78 contains
79
88 subroutine initial_nwp(this,itype,wcstart)
89 class(fcst_nwp) :: this
90
91 character(len=6), intent(in) :: itype
92 character(len=4), intent(in) :: wcstart
93
94! FVCOM grid
95 if (itype==' FVCOM') then
96 this%datatype = itype
97 this%numvar = 5
98
99 this%i_mask = 1
100 this%i_sst = 2
101 this%i_ice = 3
102 this%i_iceT = 4
103 this%i_hice = 5
104 this%i_sfcT = 0
105 this%i_zorl = 0
106
107 allocate(this%varnames(this%numvar))
108 this%varnames(1) = 'glmask'
109 this%varnames(2) = 'tsfc'
110 this%varnames(3) = 'aice'
111 this%varnames(4) = 'tisfc'
112 this%varnames(5) = 'vice'
113
114 allocate(this%latname)
115 allocate(this%lonname)
116 this%latname = 'lat'
117 this%lonname = 'lon'
118
119 allocate(this%dimnameEW)
120 allocate(this%dimnameNS)
121 allocate(this%dimnameTIME)
122 allocate(this%dimnameDATE)
123 this%dimnameEW = 'lon'
124 this%dimnameNS = 'lat'
125 this%dimnameTIME = 'Time'
126 this%dimnameDATE = 'DateStrLen'
127
128! FV3LAM grid
129
130 else if (trim(itype)=='FV3LAM' .AND. wcstart=='warm') then
131 this%datatype = itype
132 this%numvar = 8
133
134 this%i_mask = 1
135 this%i_sst = 2
136 this%i_ice = 3
137 this%i_iceT = 4
138 this%i_sfcT = 5
139 this%i_sfcTl= 6
140 this%i_zorl = 7
141 this%i_hice = 8
142
143 allocate(this%varnames(this%numvar))
144 this%varnames(1) = 'slmsk'
145 this%varnames(2) = 'tsea'
146 this%varnames(3) = 'fice'
147 this%varnames(4) = 'tisfc'
148 this%varnames(5) = 'tsfc'
149 this%varnames(6) = 'tsfcl'
150 this%varnames(7) = 'zorli'
151 this%varnames(8) = 'hice'
152
153 allocate(this%latname)
154 allocate(this%lonname)
155 this%latname = 'yaxis_1'
156 this%lonname = 'xaxis_1'
157
158 allocate(this%dimnameEW)
159 allocate(this%dimnameNS)
160 allocate(this%dimnameTIME)
161 this%dimnameEW = 'xaxis_1'
162 this%dimnameNS = 'yaxis_1'
163 this%dimnameTIME = 'Time'
164
165 else if (trim(itype)=='FV3LAM' .AND. wcstart=='cold') then
166 this%datatype = itype
167 this%numvar = 6
168
169 this%i_mask = 1
170 this%i_sst = 2
171 this%i_ice = 3
172 this%i_iceT = 4
173 this%i_zorl = 5
174 this%i_hice = 6
175 this%i_sfcT = 0
176
177 allocate(this%varnames(this%numvar))
178 this%varnames(1) = 'slmsk'
179 this%varnames(2) = 'tsea'
180 this%varnames(3) = 'fice'
181 this%varnames(4) = 'tisfc'
182 this%varnames(5) = 'zorl'
183 this%varnames(6) = 'hice'
184
185 allocate(this%latname)
186 allocate(this%lonname)
187 this%latname = 'yaxis_1'
188 this%lonname = 'xaxis_1'
189
190 allocate(this%dimnameEW)
191 allocate(this%dimnameNS)
192 allocate(this%dimnameTIME)
193 this%dimnameEW = 'xaxis_1'
194 this%dimnameNS = 'yaxis_1'
195 this%dimnameTIME = 'Time'
196
197! If the data type does not match one of the known types, exit.
198
199 else
200 write(6,*) 'Unknown data type:', itype
201 stop 1234
202 end if
203
204 write(6,*) 'Finished initial_nwp'
205 write(6,*) ' '
206
207 end subroutine initial_nwp
208
214 subroutine list_initial_nwp(this)
215
216 class(fcst_nwp) :: this
217
218 integer :: k
219
220 write(6,*) 'List initial setup for ', this%datatype
221 write(6,*) 'number of variables ', this%numvar
222 write(6,*) 'variable index: mask, sst, ice, sfcT, sfcTl'
223 write(6,'(15x,10I3)') this%i_mask, this%i_sst, this%i_ice, &
224 & this%i_sfcT, this%i_sfcTl
225 write(6,*) 'variable name:'
226 do k=1,this%numvar
227 write(6,*) k,trim(this%varnames(k))
228 enddo
229
230 write(6,*) 'Finished list_initial_nwp'
231 write(6,*) ' '
232
233 end subroutine list_initial_nwp
234
258 subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl,zorl,hice,ybegin,yend)
259
260 class(fcst_nwp) :: this
261
262 character(len=6), intent(in) :: itype
263 character(len=*), intent(in) :: filename
264 character(len=4), intent(in) :: wcstart
265
266 integer, intent(in) :: time_to_get
267 integer, intent(in) :: ybegin,yend
268 integer, intent(inout) :: numlon, numlat, numtimes
269! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:)
270 real(r_single), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) &
271 ,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:)
272
273 real(r_kind),allocatable :: tmp2d8b(:,:)
274 real(r_kind),allocatable :: tmp3d8b(:,:,:)
275
276!
277! Open the file using module_ncio.f90 code, and find the number of
278! lat/lon points
279
280 call ncdata%open(trim(filename),'r',200)
281 call ncdata%get_dim(this%dimnameEW,this%xlon)
282 call ncdata%get_dim(this%dimnameNS,this%xlat)
283 call ncdata%get_dim(this%dimnameTIME,this%xtime)
284
285 write(6,*) 'number of longitudes for file ', filename, this%xlon
286 numlon = this%xlon
287 write(6,*) 'number of latitudes for file ', filename, this%xlat
288 !numlat = this%xlat
289 numlat = yend-ybegin+1
290 write(6,*) 'number of times for file ', filename, this%xtime
291 numtimes = this%xtime
292 write(6,*) 'the range of Y for this domain is=',ybegin,yend
293
294! Allocate all the arrays to receive data
295 if (wcstart == 'cold' .OR. itype == ' FVCOM') then
296 allocate(this%nwp_mask_c(this%xlon,this%xlat))
297 allocate(this%nwp_sst_c(this%xlon,this%xlat,this%xtime))
298 allocate(this%nwp_ice_c(this%xlon,this%xlat,this%xtime))
299 allocate(this%nwp_sfcT_c(this%xlon,this%xlat,this%xtime))
300 allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime))
301 allocate(this%nwp_zorl_c(this%xlon,this%xlat,this%xtime))
302 allocate(this%nwp_hice_c(this%xlon,this%xlat,this%xtime))
303 allocate(tmp2d8b(this%xlon,this%xlat))
304 allocate(tmp3d8b(this%xlon,this%xlat,this%xtime))
305
306! Get variables from the data file, but only if the variable is
307! defined for that data type.
308
309 write(6,*) 'itype = ', itype
310 write(6,*) 'wcstart = ', wcstart
311 write(6,*) 'xlat = ', this%xlat
312 write(6,*) 'xlon = ', this%xlon
313 write(6,*) 'xtime = ', this%xtime
314
315 if (this%i_mask .gt. 0) then
316 call ncdata%get_var(this%varnames(this%i_mask),this%xlon, &
317 this%xlat,tmp2d8b)
318 this%nwp_mask_c=tmp2d8b
319 mask = this%nwp_mask_c(:,ybegin:yend)
320 end if
321 if (this%i_sst .gt. 0) then
322 write(6,*) 'get sst for cold or FVCOM'
323 call ncdata%get_var(this%varnames(this%i_sst),this%xlon, &
324 this%xlat,this%xtime,tmp3d8b)
325 this%nwp_sst_c=tmp3d8b
326 sst = this%nwp_sst_c(:,ybegin:yend,time_to_get)
327 end if
328 if (this%i_ice .gt. 0) then
329 call ncdata%get_var(this%varnames(this%i_ice),this%xlon, &
330 this%xlat,this%xtime,tmp3d8b)
331 this%nwp_ice_c=tmp3d8b
332 ice = this%nwp_ice_c(:,ybegin:yend,time_to_get)
333 end if
334 if (this%i_sfcT .gt. 0) then
335 call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, &
336 this%xlat,this%xtime,tmp3d8b)
337 this%nwp_sfcT_c=tmp3d8b
338 sfct = this%nwp_sfcT_c(:,ybegin:yend,time_to_get)
339 end if
340 if (this%i_iceT .gt. 0) then
341 call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, &
342 this%xlat,this%xtime,tmp3d8b)
343 this%nwp_iceT_c=tmp3d8b
344 icet = this%nwp_iceT_c(:,ybegin:yend,time_to_get)
345 end if
346 if (this%i_zorl .gt. 0) then
347 call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
348 this%xlat,this%xtime,tmp3d8b)
349 this%nwp_zorl_c=tmp3d8b
350 zorl = this%nwp_zorl_c(:,ybegin:yend,time_to_get)
351 end if
352 if (this%i_hice .gt. 0) then
353 call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
354 this%xlat,this%xtime,tmp3d8b)
355 this%nwp_hice_c=tmp3d8b
356 hice = this%nwp_hice_c(:,ybegin:yend,time_to_get)
357 end if
358 deallocate(tmp2d8b)
359 deallocate(tmp3d8b)
360
361 else if (wcstart == 'warm') then
362 allocate(this%nwp_mask_w(this%xlon,this%xlat))
363 allocate(this%nwp_sst_w(this%xlon,this%xlat))
364 allocate(this%nwp_ice_w(this%xlon,this%xlat))
365 allocate(this%nwp_sfcT_w(this%xlon,this%xlat))
366 allocate(this%nwp_iceT_w(this%xlon,this%xlat))
367 allocate(this%nwp_sfcTl_w(this%xlon,this%xlat))
368 allocate(this%nwp_zorl_w(this%xlon,this%xlat))
369 allocate(this%nwp_hice_w(this%xlon,this%xlat))
370! Get variables from the data file, but only if the variable is
371! defined for that data type.
372
373 write(6,*) 'itype = ', itype
374 write(6,*) 'wcstart =', wcstart
375 write(6,*) 'xlat = ', this%xlat
376 write(6,*) 'xlon = ', this%xlon
377 write(6,*) 'xtime = ', this%xtime
378
379 if (this%i_mask .gt. 0) then
380 call ncdata%get_var(this%varnames(this%i_mask),this%xlon, &
381 this%xlat,this%nwp_mask_w)
382 mask = this%nwp_mask_w(:,ybegin:yend)
383 end if
384 if (this%i_sst .gt. 0) then
385 call ncdata%get_var(this%varnames(this%i_sst),this%xlon, &
386 this%xlat,this%nwp_sst_w)
387 sst = this%nwp_sst_w(:,ybegin:yend)
388 end if
389 if (this%i_ice .gt. 0) then
390 call ncdata%get_var(this%varnames(this%i_ice),this%xlon, &
391 this%xlat,this%nwp_ice_w)
392 ice = this%nwp_ice_w(:,ybegin:yend)
393 end if
394 if (this%i_sfcT .gt. 0) then
395 call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, &
396 this%xlat,this%nwp_sfcT_w)
397 sfct = this%nwp_sfcT_w(:,ybegin:yend)
398 end if
399 if (this%i_iceT .gt. 0) then
400 call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, &
401 this%xlat,this%nwp_iceT_w)
402 icet = this%nwp_iceT_w(:,ybegin:yend)
403 end if
404 if (this%i_sfcTl .gt. 0) then
405 call ncdata%get_var(this%varnames(this%i_sfcTl),this%xlon, &
406 this%xlat,this%nwp_sfcTl_w)
407 sfctl = this%nwp_sfcTl_w(:,ybegin:yend)
408 end if
409 if (this%i_zorl .gt. 0) then
410 call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
411 this%xlat,this%nwp_zorl_w)
412 zorl = this%nwp_zorl_w(:,ybegin:yend)
413 end if
414 if (this%i_hice .gt. 0) then
415 call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
416 this%xlat,this%nwp_hice_w)
417 hice = this%nwp_hice_w(:,ybegin:yend)
418 end if
419
420 else
421 write(6,*) 'Choose either "warm" or "cold" for file'
422 stop 'Error in wcstart. Check spelling or if variable was assigned'
423 end if
424! Close the netCDF file.
425
426 call ncdata%close
427
428 write(6,*) 'Finished read_nwp'
429 write(6,*) ' '
430
431 end subroutine read_nwp
432
439 subroutine finish_nwp(this,itype,wcstart)
440
441 class(fcst_nwp) :: this
442 character(len=6), intent(in) :: itype
443 character(len=4), intent(in) :: wcstart
444
445 deallocate(this%varnames)
446 deallocate(this%latname)
447 deallocate(this%lonname)
448 deallocate(this%dimnameEW)
449 deallocate(this%dimnameNS)
450 deallocate(this%dimnameTIME)
451 if (wcstart == 'cold' .OR. itype==' FVCOM') then
452 deallocate(this%nwp_mask_c)
453 deallocate(this%nwp_sst_c)
454 deallocate(this%nwp_ice_c)
455 deallocate(this%nwp_sfcT_c)
456 deallocate(this%nwp_iceT_c)
457 deallocate(this%nwp_zorl_c)
458 deallocate(this%nwp_hice_c)
459 if (itype==' FVCOM') deallocate(this%dimnameDATE)
460 else if (wcstart == 'warm') then
461 deallocate(this%nwp_mask_w)
462 deallocate(this%nwp_sst_w)
463 deallocate(this%nwp_ice_w)
464 deallocate(this%nwp_sfcT_w)
465 deallocate(this%nwp_iceT_w)
466 deallocate(this%nwp_sfcTl_w)
467 deallocate(this%nwp_zorl_w)
468 deallocate(this%nwp_hice_w)
469 else
470 write(6,*) 'no deallocation'
471 end if
472
473 write(6,*) 'Finished finish_nwp'
474 write(6,*) ' '
475
476 end subroutine finish_nwp
477
487 subroutine get_time_ind_nwp(this,filename,instr,outindex)
488
489 class(fcst_nwp) :: this
490
491 character(len=*), intent(in) :: filename
492 character(len=*), intent(in) :: instr
493 integer, intent(out) :: outindex
494
495 character(len=26) :: temp
496 integer :: foundind
497 integer :: k,i
498
499! Open the file using module_ncio.f90 code, and find the length of
500! time in the file
501 call ncdata%open(trim(filename),'r',200)
502 call ncdata%get_dim(this%dimnameTIME,this%xtime)
503 call ncdata%get_dim(this%dimnameDATE,this%datelen)
504 write(6,*) 'xtime = ', this%xtime
505 write(6,*) 'datelen = ', this%datelen
506 allocate(this%times(this%datelen,this%xtime))
507 call ncdata%get_var('Times',this%datelen,this%xtime,this%times)
508
509 foundind = 0
510
511 do k=1,this%xtime,1
512 do i = 1,len(temp),1
513 temp(i:i) = this%times(i,k)
514 end do
515 if (trim(temp) == trim(instr)) then !If times are equal return k
516 outindex = k
517 foundind = 1
518 end if
519 end do
520 if (foundind == 0) then
521 outindex = -999
522 deallocate(this%times)
523 call ncdata%close
524 write(6,*) 'WARNING: Supplied time not found in file: ', trim(instr)
525 write(6,*) 'Stoppping fvcom_to_FV3 and proceeding without using FVCOM data'
526 stop
527 end if
528
529 deallocate(this%times)
530 call ncdata%close
531
532 end subroutine get_time_ind_nwp
533
534end module module_nwp
kinds
Module to hold specification kinds for variable declaration.
Definition kinds.f90:11
kinds::r_single
integer, parameter, public r_single
specification kind for single precision (4-byte) real variable.
Definition kinds.f90:25
kinds::r_kind
integer, parameter, public r_kind
generic specification kind for default floating point
Definition kinds.f90:26
kinds::i_short
integer, parameter, public i_short
generic specification kind for default short.
Definition kinds.f90:22
kinds::rmissing
real(r_single), parameter, public rmissing
Fill value for single real missing data.
Definition kinds.f90:29
module_ncio
Functions to read and write netcdf files.
Definition module_ncio.f90:7
module_nwp
This module defines FV3LAM and FVCOM forecast data structure and the method to read and write observa...
Definition module_nwp.f90:15
module_nwp::read_nwp
subroutine read_nwp(this, filename, itype, wcstart, numlon, numlat, numtimes, time_to_get, mask, sst, ice, sfct, icet, sfctl, zorl, hice, ybegin, yend)
This subroutine initializes arrays to receive the NWP data, and opens the file and gets the data.
Definition module_nwp.f90:259
module_nwp::list_initial_nwp
subroutine list_initial_nwp(this)
This subroutine lists the setup for NWP data that was done by the initial_nwp subroutine.
Definition module_nwp.f90:215
module_nwp::get_time_ind_nwp
subroutine get_time_ind_nwp(this, filename, instr, outindex)
This subroutine searches the FVCOM 'Times' variable and returns the matching index.
Definition module_nwp.f90:488
module_nwp::finish_nwp
subroutine finish_nwp(this, itype, wcstart)
Finish and deallocate.
Definition module_nwp.f90:440
module_nwp::initial_nwp
subroutine initial_nwp(this, itype, wcstart)
This subroutine defines the number of variables and their names for each NWP data type.
Definition module_nwp.f90:89
module_nwp::ncdata
type(ncio) ncdata
Wrapper object for netCDF data file.
Definition module_nwp.f90:75
module_ncio::ncio
Definition module_ncio.f90:16
module_nwp::fcst_nwp
Definition module_nwp.f90:26