source: flexpart.git/flexpart_code/GRIB2FLEXPART.F90 @ fd86dea

FPv9.3.2grib2nc4_repair
Last change on this file since fd86dea was fd86dea, checked in by Don Morton <Don.Morton@…>, 7 years ago

Prepared what I hope to be a stable FPv9.3.2 for CTBTO testing

  • Property mode set to 100644
File size: 9.8 KB
Line 
1!**********************************************************************
2! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
3! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
4! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
5!                                                                     *
6! This file is part of FLEXPART.                                      *
7!                                                                     *
8! FLEXPART is free software: you can redistribute it and/or modify    *
9! it under the terms of the GNU General Public License as published by*
10! the Free Software Foundation, either version 3 of the License, or   *
11! (at your option) any later version.                                 *
12!                                                                     *
13! FLEXPART is distributed in the hope that it will be useful,         *
14! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
16! GNU General Public License for more details.                        *
17!                                                                     *
18! You should have received a copy of the GNU General Public License   *
19! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
20!**********************************************************************
21
22program grib2flexpart
23
24  !*****************************************************************************
25  !                                                                            *
26  !     This is the GRIB 2 FP conversion routine                               *
27  !                                                                            *
28  !     Author: M. Harustak                                                    *
29  !                                                                            *
30  !     05 October 2015                                                        *
31  !                                                                            *
32  !*****************************************************************************
33  !                                                                            *
34  ! Variables:                                                                 *
35  !                                                                            *
36  ! Constants:                                                                 *
37  !                                                                            *
38  !*****************************************************************************
39
40  use point_mod
41  use par_mod
42  use com_mod
43  use conv_mod
44
45  implicit none
46
47  integer :: metdata_format = unknown_metdata
48  integer :: itime, nstop1
49  integer :: i
50  character(len=256) :: arg
51  character(len=512) :: dumpPath
52  character(len=512) :: inputFileName
53  character(len=512) :: nestedFileName
54  character(len=32) :: lsubgridTXT
55  integer :: useAvailable = 0
56  integer :: overwritecheck
57
58  ! Print the GPL License statement
59  !*******************************************************
60#if defined CTBTO
61  print*,'Welcome to GRIB2FLEXPART Version 9.3.2 CTBTO'
62#else
63  print*,'Welcome to GRIB2FLEXPART Version 9.3.2'
64#endif
65
66  print*,'FLEXPART is free software released under the GNU Genera'// &
67       'l Public License.'
68
69  ! no argument => error
70  if (( iargc().lt.2 ).or.( iargc().eq.3)) then
71    print *,' '
72    print *,'Usage in use-available mode: grib2flexpart useAvailable <output directory>'
73    print *,'Usage in command line mode: grib2flexpart forward|backward subgrid <output directory> <source file> [<source file>...]'
74    print *,' '
75    stop 'Error: Missing arguments'
76  elseif ( iargc().eq.2 ) then
77    call getarg(1,arg)
78    if ( arg.eq."useAvailable" ) then
79      print *,'Running in use-available mode'
80      useAvailable = 1
81    else
82      print *,' '
83      print *,'Usage in use-available mode: grib2flexpart useAvailable <output directory>'
84      print *,'Usage in command line mode: grib2flexpart forward|backward subgrid <output directory> &
85 <source file> [<source file>...]'
86      print *,' '
87      stop 'Error: Incorrect arguments'
88    endif
89  else
90    ! 2 and more arguments => ok, parse arguments
91    call getarg(1,arg)
92    if ( arg.eq."forward") then
93      ldirect = 1
94    else if ( arg.eq."backward") then
95      ldirect = -1
96    else
97      print *,' '
98      print *,'Usage in use-available mode: grib2flexpart useAvailable <output directory>'
99      print *,'Usage in command line mode: grib2flexpart forward|backward subgrid <output directory> &
100<source file> [<source file>...]'
101      print *,' '
102      stop 'Error: Incorrect arguments'
103    endif
104    print *,'Running in command line mode'
105    useAvailable = 0
106  endif
107
108  if ( useAvailable.eq.0 ) then
109    call getarg(2,lsubgridTxt)
110    read (lsubgridTxt, '(i10)') lsubgrid
111    lsubgrid=1
112    call getarg(3,dumpPath)
113    do i=4,iargc()
114      call getarg(i,inputFileName)
115      numbwf = i - 4 + 1
116      if ( ldirect.eq.1 ) then
117        wfname(i-4+1) = inputFileName
118        if ( overwritecheck( dumpPath, wfname(i-4+1), 0) == -1 ) then
119          ! if the output and input directory is the same, exit with error
120          print *, "Input and output paths must be different"
121          print *, "Output: "//trim(dumpPath)
122          print *, "input: "//trim(wfname(i-4+1))
123          stop 'Error: Incorrect arguments'
124        endif
125      else
126        wfname(iargc()+1-i) = inputFileName
127        if ( overwritecheck( dumpPath, wfname(iargc()+1-i), 0) == -1 ) then
128          ! if the output and input directory is the same, exit with error
129          print *, "Input and output paths must be different"
130          print *, "Output: "//trim(dumpPath)
131          print *, "Input: "//trim(wfname(iargc()+1-i))
132          stop 'Error: Incorrect arguments'
133        endif
134      endif
135    end do
136
137  else
138    call getarg(2,dumpPath)
139
140    call readpaths
141
142    call readcommand
143
144    call readavailable
145    do i=1,numbwf
146      if ( overwritecheck( dumpPath, path(3)(1:length(3)) // trim(wfname(i)),0) == -1) then
147          ! if the output and input directory is the same, exit with error
148          print *, "Input and output paths must be different"
149          print *, "Output: "//trim(dumpPath)
150          print *, "Input: "//path(3)(1:length(3)) // trim(wfname(i))
151          stop 'Error: Incorrect arguments'
152        endif
153    enddo
154  endif
155
156
157! Reset the times of the wind fields that are kept in memory to no time
158 !**********************************************************************
159
160  do i=1,2
161    memind(i)=i
162    memtime(i)=999999999
163  end do
164
165  ! Detect metdata format
166  call detectformat(metdata_format)
167  if (metdata_format.eq.ecmwf_metdata) then
168    print*,'ECMWF metdata detected'
169  elseif (metdata_format.eq.gfs_metdata) then
170    print*,'NCEP metdata detected'
171  else
172    stop 'Unknown metdata format'
173  endif
174
175  ! Read the model grid specifications,
176  ! both for the mother domain and eventual nests
177  !**********************************************
178
179  if (metdata_format.eq.ecmwf_metdata) call gridcheck_ecmwf
180  if (metdata_format.eq.gfs_metdata) call gridcheck_gfs
181  call gridcheck_nests
182
183  do i=1,numbwf
184    if ( ( useAvailable.eq.0 ).or.(numbwf.eq.1) ) then
185      print *,' '
186      print *,wfname(i)
187      call convertfields( i, metdata_format, dumpPath)
188    else
189       if (((ldirect*wftime(i).le.0).and. &
190             (ldirect*wftime(i+1).gt.0)).or. &
191          (ldirect*wftime(i).gt.0)) then
192          print *,' '
193          print *,wfname(i)
194          call convertfields( i, metdata_format, dumpPath)
195       endif
196    endif
197  end do
198
199  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A GRIB2FLE&
200       &XPART PREPROCESSING RUN!'
201
202end program grib2flexpart
203
204! This function checks whether input and output directories differ
205! It does so by creating tmp file in output directory and by checking for its presence in input one
206! It's does this way to avoid the need for relative 2 absolute path expansion and to avoid handling of links
207integer function overwritecheck( dump_path, input_path, input_is_path )
208  character(len=*) :: dump_path, input_path
209  integer :: input_is_path, open_status
210  character(len=512) :: tmp_file_name, tmp_file_path, check_file_path
211  character(len=64) :: pid, current_time
212  logical :: exists
213
214  overwritecheck = 1
215
216  write (pid,*) getpid()
217  write (current_time, *) time()
218  ! generate tmp file name using PID and timestamp
219  !! tmp_file_name = "overwritecheck_"//trim(adjustl(pid))//"_"//trim(adjustl(current_time))//".tmp"
220  !! tmp_file_path = trim(dump_path)//"/"//trim(tmp_file_name)
221
222  ! create tmp file in output directory
223  !! open(10001, file=trim(tmp_file_path), status="new", action="write", iostat=open_status)
224  ! check for tmp file
225  !! if ( open_status /= 0 ) then
226  !!   print *, "Output directory does not exist or is not writeable"
227  !!   print *, "File "//trim(tmp_file_path)//", iostat=",open_status
228  !!   print *, "PID: ", pid, getpid()
229  !!   print *, "current_time: ", current_time
230
231  !!   stop 'Error: Incorrect arguments'
232  !! endif
233   
234  ! generate tmp file name in input directory
235  if ( input_is_path == 1) then
236    !! check_file_path = trim(input_path)//"/"//trim(tmp_file_name)
237    stop 'Error: Incorrect arguments; input file is path'
238  else
239    if ( scan(input_path, '/') == 0 ) then
240       check_file_path=trim(dump_path)//"/"//trim(input_path)
241    else
242       check_file_path=trim(dump_path)//trim(input_path(scan(input_path, '/', .TRUE.):))
243    endif
244  endif
245  !check for file presence
246  print *, "Check if output file "//trim(check_file_path)//" exists ..."
247  inquire(file=TRIM(check_file_path), exist=exists)
248  ! delete tmp file
249  !! close(10001, status='DELETE')
250  if ( exists ) then
251    overwritecheck = -1
252    print *, "Warning: Output file "//trim(check_file_path)//" exists"
253    stop 'Please remove this file if the output directory is correct'
254  endif
255 
256end function
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG