fvcom_tools  1.10.0
All Data Structures Namespaces Files Functions Variables Pages
module_nwp.f90
Go to the documentation of this file.
1 
4 
15 module 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_kind), allocatable :: nwp_mask_c(:,:)
51  real(r_kind), allocatable :: nwp_sst_c(:,:,:)
52  real(r_kind), allocatable :: nwp_ice_c(:,:,:)
53  real(r_kind), allocatable :: nwp_sfct_c(:,:,:)
54  real(r_kind), allocatable :: nwp_icet_c(:,:,:)
55  real(r_kind), allocatable :: nwp_zorl_c(:,:,:)
56  real(r_kind), allocatable :: nwp_hice_c(:,:,:)
57 
58  real(r_kind), allocatable :: nwp_mask_w(:,:)
59  real(r_kind), allocatable :: nwp_sst_w(:,:)
60  real(r_kind), allocatable :: nwp_ice_w(:,:)
61  real(r_kind), allocatable :: nwp_sfct_w(:,:)
62  real(r_kind), allocatable :: nwp_icet_w(:,:)
63  real(r_kind), allocatable :: nwp_sfctl_w(:,:)
64  real(r_kind), allocatable :: nwp_zorl_w(:,:)
65  real(r_kind), 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)
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)
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_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) &
271  ,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:)
272 
273 !
274 ! Open the file using module_ncio.f90 code, and find the number of
275 ! lat/lon points
276 
277  call ncdata%open(trim(filename),'r',200)
278  call ncdata%get_dim(this%dimnameEW,this%xlon)
279  call ncdata%get_dim(this%dimnameNS,this%xlat)
280  call ncdata%get_dim(this%dimnameTIME,this%xtime)
281 
282  write(6,*) 'number of longitudes for file ', filename, this%xlon
283  numlon = this%xlon
284  write(6,*) 'number of latitudes for file ', filename, this%xlat
285  !numlat = this%xlat
286  numlat = yend-ybegin+1
287  write(6,*) 'number of times for file ', filename, this%xtime
288  numtimes = this%xtime
289  write(6,*) 'the range of Y for this domain is=',ybegin,yend
290 
291 ! Allocate all the arrays to receive data
292  if (wcstart == 'cold' .OR. itype == ' FVCOM') then
293  allocate(this%nwp_mask_c(this%xlon,this%xlat))
294  allocate(this%nwp_sst_c(this%xlon,this%xlat,this%xtime))
295  allocate(this%nwp_ice_c(this%xlon,this%xlat,this%xtime))
296  allocate(this%nwp_sfcT_c(this%xlon,this%xlat,this%xtime))
297  allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime))
298  allocate(this%nwp_zorl_c(this%xlon,this%xlat,this%xtime))
299  allocate(this%nwp_hice_c(this%xlon,this%xlat,this%xtime))
300 
301 ! Get variables from the data file, but only if the variable is
302 ! defined for that data type.
303 
304  write(6,*) 'itype = ', itype
305  write(6,*) 'wcstart = ', wcstart
306  write(6,*) 'xlat = ', this%xlat
307  write(6,*) 'xlon = ', this%xlon
308  write(6,*) 'xtime = ', this%xtime
309 
310  if (this%i_mask .gt. 0) then
311  call ncdata%get_var(this%varnames(this%i_mask),this%xlon, &
312  this%xlat,this%nwp_mask_c)
313  mask = this%nwp_mask_c(:,ybegin:yend)
314  end if
315  if (this%i_sst .gt. 0) then
316  write(6,*) 'get sst for cold or FVCOM'
317  call ncdata%get_var(this%varnames(this%i_sst),this%xlon, &
318  this%xlat,this%xtime,this%nwp_sst_c)
319  sst = this%nwp_sst_c(:,ybegin:yend,time_to_get)
320  end if
321  if (this%i_ice .gt. 0) then
322  call ncdata%get_var(this%varnames(this%i_ice),this%xlon, &
323  this%xlat,this%xtime,this%nwp_ice_c)
324  ice = this%nwp_ice_c(:,ybegin:yend,time_to_get)
325  end if
326  if (this%i_sfcT .gt. 0) then
327  call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, &
328  this%xlat,this%xtime,this%nwp_sfcT_c)
329  sfct = this%nwp_sfcT_c(:,ybegin:yend,time_to_get)
330  end if
331  if (this%i_iceT .gt. 0) then
332  call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, &
333  this%xlat,this%xtime,this%nwp_iceT_c)
334  icet = this%nwp_iceT_c(:,ybegin:yend,time_to_get)
335  end if
336  if (this%i_zorl .gt. 0) then
337  call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
338  this%xlat,this%xtime,this%nwp_zorl_c)
339  zorl = this%nwp_zorl_c(:,ybegin:yend,time_to_get)
340  end if
341  if (this%i_hice .gt. 0) then
342  call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
343  this%xlat,this%xtime,this%nwp_hice_c)
344  hice = this%nwp_hice_c(:,ybegin:yend,time_to_get)
345  end if
346 
347  else if (wcstart == 'warm') then
348  allocate(this%nwp_mask_w(this%xlon,this%xlat))
349  allocate(this%nwp_sst_w(this%xlon,this%xlat))
350  allocate(this%nwp_ice_w(this%xlon,this%xlat))
351  allocate(this%nwp_sfcT_w(this%xlon,this%xlat))
352  allocate(this%nwp_iceT_w(this%xlon,this%xlat))
353  allocate(this%nwp_sfcTl_w(this%xlon,this%xlat))
354  allocate(this%nwp_zorl_w(this%xlon,this%xlat))
355  allocate(this%nwp_hice_w(this%xlon,this%xlat))
356 ! Get variables from the data file, but only if the variable is
357 ! defined for that data type.
358 
359  write(6,*) 'itype = ', itype
360  write(6,*) 'wcstart =', wcstart
361  write(6,*) 'xlat = ', this%xlat
362  write(6,*) 'xlon = ', this%xlon
363  write(6,*) 'xtime = ', this%xtime
364 
365  if (this%i_mask .gt. 0) then
366  call ncdata%get_var(this%varnames(this%i_mask),this%xlon, &
367  this%xlat,this%nwp_mask_w)
368  mask = this%nwp_mask_w(:,ybegin:yend)
369  end if
370  if (this%i_sst .gt. 0) then
371  call ncdata%get_var(this%varnames(this%i_sst),this%xlon, &
372  this%xlat,this%nwp_sst_w)
373  sst = this%nwp_sst_w(:,ybegin:yend)
374  end if
375  if (this%i_ice .gt. 0) then
376  call ncdata%get_var(this%varnames(this%i_ice),this%xlon, &
377  this%xlat,this%nwp_ice_w)
378  ice = this%nwp_ice_w(:,ybegin:yend)
379  end if
380  if (this%i_sfcT .gt. 0) then
381  call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, &
382  this%xlat,this%nwp_sfcT_w)
383  sfct = this%nwp_sfcT_w(:,ybegin:yend)
384  end if
385  if (this%i_iceT .gt. 0) then
386  call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, &
387  this%xlat,this%nwp_iceT_w)
388  icet = this%nwp_iceT_w(:,ybegin:yend)
389  end if
390  if (this%i_sfcTl .gt. 0) then
391  call ncdata%get_var(this%varnames(this%i_sfcTl),this%xlon, &
392  this%xlat,this%nwp_sfcTl_w)
393  sfctl = this%nwp_sfcTl_w(:,ybegin:yend)
394  end if
395  if (this%i_zorl .gt. 0) then
396  call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
397  this%xlat,this%nwp_zorl_w)
398  zorl = this%nwp_zorl_w(:,ybegin:yend)
399  end if
400  if (this%i_hice .gt. 0) then
401  call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
402  this%xlat,this%nwp_hice_w)
403  hice = this%nwp_hice_w(:,ybegin:yend)
404  end if
405 
406  else
407  write(6,*) 'Choose either "warm" or "cold" for file'
408  stop 'Error in wcstart. Check spelling or if variable was assigned'
409  end if
410 ! Close the netCDF file.
411 
412  call ncdata%close
413 
414  write(6,*) 'Finished read_nwp'
415  write(6,*) ' '
416 
417  end subroutine read_nwp
418 
425  subroutine finish_nwp(this,itype,wcstart)
427  class(fcst_nwp) :: this
428  character(len=6), intent(in) :: itype
429  character(len=4), intent(in) :: wcstart
430 
431  deallocate(this%varnames)
432  deallocate(this%latname)
433  deallocate(this%lonname)
434  deallocate(this%dimnameEW)
435  deallocate(this%dimnameNS)
436  deallocate(this%dimnameTIME)
437  if (wcstart == 'cold' .OR. itype==' FVCOM') then
438  deallocate(this%nwp_mask_c)
439  deallocate(this%nwp_sst_c)
440  deallocate(this%nwp_ice_c)
441  deallocate(this%nwp_sfcT_c)
442  deallocate(this%nwp_iceT_c)
443  deallocate(this%nwp_zorl_c)
444  deallocate(this%nwp_hice_c)
445  if (itype==' FVCOM') deallocate(this%dimnameDATE)
446  else if (wcstart == 'warm') then
447  deallocate(this%nwp_mask_w)
448  deallocate(this%nwp_sst_w)
449  deallocate(this%nwp_ice_w)
450  deallocate(this%nwp_sfcT_w)
451  deallocate(this%nwp_iceT_w)
452  deallocate(this%nwp_sfcTl_w)
453  deallocate(this%nwp_zorl_w)
454  deallocate(this%nwp_hice_w)
455  else
456  write(6,*) 'no deallocation'
457  end if
458 
459  write(6,*) 'Finished finish_nwp'
460  write(6,*) ' '
461 
462  end subroutine finish_nwp
463 
473  subroutine get_time_ind_nwp(this,filename,instr,outindex)
475  class(fcst_nwp) :: this
476 
477  character(len=*), intent(in) :: filename
478  character(len=*), intent(in) :: instr
479  integer, intent(out) :: outindex
480 
481  character(len=26) :: temp
482  integer :: foundind
483  integer :: k,i
484 
485 ! Open the file using module_ncio.f90 code, and find the length of
486 ! time in the file
487  call ncdata%open(trim(filename),'r',200)
488  call ncdata%get_dim(this%dimnameTIME,this%xtime)
489  call ncdata%get_dim(this%dimnameDATE,this%datelen)
490  write(6,*) 'xtime = ', this%xtime
491  write(6,*) 'datelen = ', this%datelen
492  allocate(this%times(this%datelen,this%xtime))
493  call ncdata%get_var('Times',this%datelen,this%xtime,this%times)
494 
495  foundind = 0
496 
497  do k=1,this%xtime,1
498  do i = 1,len(temp),1
499  temp(i:i) = this%times(i,k)
500  end do
501  if (trim(temp) == trim(instr)) then !If times are equal return k
502  outindex = k
503  foundind = 1
504  end if
505  end do
506  if (foundind == 0) then
507  outindex = -999
508  deallocate(this%times)
509  call ncdata%close
510  write(6,*) 'WARNING: Supplied time not found in file: ', trim(instr)
511  write(6,*) 'Stoppping fvcom_to_FV3 and proceeding without using FVCOM data'
512  stop
513  end if
514 
515  deallocate(this%times)
516  call ncdata%close
517 
518  end subroutine get_time_ind_nwp
519 
520 end module module_nwp
subroutine finish_nwp(this, itype, wcstart)
Finish and deallocate.
Definition: module_nwp.f90:426
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
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:474
type(ncio) ncdata
Wrapper object for netCDF data file.
Definition: module_nwp.f90:75
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
real(r_single), parameter, public rmissing
Fill value for single real missing data.
Definition: kinds.f90:29
Functions to read and write netcdf files.
Definition: module_ncio.f90:7
integer, parameter, public i_short
generic specification kind for default short.
Definition: kinds.f90:22
This module defines FV3LAM and FVCOM forecast data structure and the method to read and write observa...
Definition: module_nwp.f90:15
integer, parameter, public r_kind
generic specification kind for default floating point
Definition: kinds.f90:26
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
integer, parameter, public r_single
specification kind for single precision (4-byte) real variable.
Definition: kinds.f90:25
Module to hold specification kinds for variable declaration.
Definition: kinds.f90:11