source: flexpart.git/src/writeprecip.f90 @ 027e844

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 027e844 was 6985a98, checked in by Sabine <sabine.eckhardt@…>, 7 years ago

compiles after merge scavenging into test dev

  • Property mode set to 100644
File size: 3.5 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
22subroutine writeprecip(itime,imem)
23
24  !*****************************************************************************
25  !                                                                            *
26  !  This routine produces a file containing total precipitation for each      *
27  !  releases point.                                                           *
28  !                                                                            *
29  !     Author: S. Eckhardt                                                    *
30  !     7 Mai 2017                                                             *
31  !*****************************************************************************
32
33  use point_mod
34  use par_mod
35  use com_mod
36
37  implicit none
38
39  integer :: jjjjmmdd,ihmmss,itime,i
40  real(kind=dp) :: jul
41  character :: adate*8,atime*6
42
43  integer :: ix,jy,imem
44  real :: xp1,yp1
45
46 
47  if (itime.eq.0) then
48      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
49       form='formatted',err=998)
50  else
51      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
52       ACCESS='APPEND',form='formatted',err=998)
53  endif
54
55  jul=bdate+real(itime,kind=dp)/86400._dp
56  call caldate(jul,jjjjmmdd,ihmmss)
57  write(adate,'(i8.8)') jjjjmmdd
58  write(atime,'(i6.6)') ihmmss
59
60  do i=1,numpoint
61    xp1=xpoint1(i)*dx+xlon0 !lat, long (real) coord
62    yp1=ypoint1(i)*dy+ylat0 !lat, long (real) coord
63    ix=int((xpoint1(i)+xpoint2(i))/2.)
64    jy=int((ypoint1(i)+ypoint2(i))/2.)
65    write(unitprecip,*)  jjjjmmdd, ihmmss, &
66           xp1,yp1,lsprec(ix,jy,1,imem),convprec(ix,jy,1,imem) !time is the same as in the ECMWF windfield
67! units mm/h, valid for the time given in the windfield
68  end do
69
70  close(unitprecip)
71
72  return
73
74
75998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
76  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
77  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
78  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
79  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
80  stop
81
82end subroutine writeprecip
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG