NCEPLIBS-nemsio  2.5.3
•All Data Structures Files
nemsio_chgdate.f90
Go to the documentation of this file.
1 
10 program nemsio_chgdate
11 
12 use nemsio_module, only: nemsio_init, nemsio_open, nemsio_close
13 use nemsio_module, only: nemsio_intkind
14 use nemsio_module, only: nemsio_gfile, nemsio_getfilehead, &
15  nemsio_setheadvar
16 
17 implicit none
18 
19 character(len=50) :: filename
20 character(len=10) :: idatestr, nfhourstr
21 integer(nemsio_intkind) :: iret
22 integer(nemsio_intkind) :: idate(7), nfhour
23 
24 type(nemsio_gfile) :: gfile
25 
26 ! replace idate and nfhour in this file
27 call getarg(1, filename)
28 
29 ! read idate to replace
30 call getarg(2, idatestr)
31 
32 ! read nfhour to replace
33 call getarg(3, nfhourstr)
34 
35 write(6,'(A)')'NEMSIO_CHGDATE:'
36 write(6,'(2(A))')' filename = ',trim(filename)
37 write(6,'(2(A))')' new idate = ',trim(idatestr)
38 write(6,'(2(A))')' new nfhour = ',trim(nfhourstr)
39 
40 call nemsio_init(iret=iret)
41 call nemsio_error(iret, 'open to initialize nemsio')
42 
43 call nemsio_open(gfile, trim(filename), 'RDWR', iret=iret)
44 call nemsio_error(iret, 'open to READ and WRITE' // trim(filename))
45 
46 call nemsio_getfilehead(gfile, idate=idate, nfhour=nfhour, iret=iret)
47 call nemsio_error(iret, 'getfilehead (idate) from ' // trim(filename))
48 
49 write(6,'(A,7(1X,I6))') 'OLD idate = ', idate
50 write(6,'(A,I4)') 'OLD nfhour = ', nfhour
51 
52 ! Replace old date with new dates
53 read(idatestr(1:4), '(I4)') idate(1)
54 read(idatestr(5:6), '(I2)') idate(2)
55 read(idatestr(7:8), '(I2)') idate(3)
56 read(idatestr(9:10), '(I2)')idate(4)
57 read(nfhourstr, '(I10)') nfhour
58 
59 write(6,'(A,7(1X,I6))') 'NEW idate = ', idate
60 write(6,'(A,I4)') 'NEW nfhour = ', nfhour
61 
62 call nemsio_setheadvar(gfile, 'idate', idate, iret=iret)
63 call nemsio_error(iret, 'setfilehead (idate) in ' // trim(filename))
64 call nemsio_setheadvar(gfile, 'nfhour', nfhour, iret=iret)
65 call nemsio_error(iret, 'setfilehead (nfhour) in ' // trim(filename))
66 
67 call nemsio_close(gfile, iret=iret)
68 call nemsio_error(iret, 'close file ' // trim(filename))
69 
70 stop
71 
72 contains
73 
74 subroutine nemsio_error(iret, msg)
75 
76 implicit none
77 
78 integer(nemsio_intkind), intent(in) :: iret
79 character(len=*), intent(in) :: msg
80 
81 character(len=500) :: msgout
82 
83 if ( iret /= 0 ) then
84 
85  msgout = '***ERROR*** Unable to ' // trim(msg) // ' ABORT!'
86  write(6,*) trim(msgout)
87  stop 99
88 
89 endif
90 
91 end subroutine nemsio_error
92 
93 END program nemsio_chgdate