source: trunk/src/partoutput_short.f90 @ 28

Last change on this file since 28 was 4, checked in by mlanger, 10 years ago
File size: 5.4 KB
RevLine 
[4]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 partoutput_short(itime)
23  !                              i
24  !*****************************************************************************
25  !                                                                            *
26  !     Dump all particle positions                                            *
27  !                                                                            *
28  !     Author: A. Stohl                                                       *
29  !                                                                            *
30  !     12 March 1999                                                          *
31  !                                                                            *
32  !*****************************************************************************
33  !                                                                            *
34  ! Variables:                                                                 *
35  !                                                                            *
36  !*****************************************************************************
37
38  use par_mod
39  use com_mod
40
41  implicit none
42
43  real(kind=dp) :: jul
44  integer :: itime,i,j,jjjjmmdd,ihmmss,numshortout,numshortall
45  integer :: ix,jy,ixp,jyp
46  real :: xlon,ylat,zlim,dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,topo
47  character :: adate*8,atime*6
48
49  integer(kind=2) :: idump(3,maxpart)
50  integer :: i4dump(maxpart)
51
52
53  ! Determine current calendar date, needed for the file name
54  !**********************************************************
55
56  jul=bdate+real(itime,kind=dp)/86400._dp
57  call caldate(jul,jjjjmmdd,ihmmss)
58  write(adate,'(i8.8)') jjjjmmdd
59  write(atime,'(i6.6)') ihmmss
60
61
62  ! Some variables needed for temporal interpolation
63  !*************************************************
64
65  dt1=real(itime-memtime(1))
66  dt2=real(memtime(2)-itime)
67  dtt=1./(dt1+dt2)
68
69
70  ! Loop about all particles
71  !*************************
72
73  numshortout=0
74  numshortall=0
75  do i=1,numpart
76
77  ! Take only valid particles
78  !**************************
79
80    if (itra1(i).eq.itime) then
81      xlon=xlon0+xtra1(i)*dx
82      ylat=ylat0+ytra1(i)*dy
83
84  !*****************************************************************************
85  ! Interpolate several variables (PV, specific humidity, etc.) to particle position
86  !*****************************************************************************
87
88      ix=xtra1(i)
89      jy=ytra1(i)
90      ixp=ix+1
91      jyp=jy+1
92      ddx=xtra1(i)-real(ix)
93      ddy=ytra1(i)-real(jy)
94      rddx=1.-ddx
95      rddy=1.-ddy
96      p1=rddx*rddy
97      p2=ddx*rddy
98      p3=rddx*ddy
99      p4=ddx*ddy
100
101  ! Topography
102  !***********
103
104      topo=p1*oro(ix ,jy) &
105           + p2*oro(ixp,jy) &
106           + p3*oro(ix ,jyp) &
107           + p4*oro(ixp,jyp)
108
109
110  ! Convert positions to integer*2 variables (from -32768 to 32767)
111  ! Do this only for region of main interest, i.e. extended North Atlantic region,
112  ! and for the tracer of interest, i.e. the North American one
113  !*****************************************************************************
114
115      if (xlon.gt.180.) xlon=xlon-360.
116      if (xlon.lt.-180.) xlon=xlon+360.
117
118      numshortall=numshortall+1
119      if ((xlon.gt.-140).and.(xlon.lt.60).and.(ylat.gt.10).and. &
120           (xmass1(i,1).gt.0.)) then
121        numshortout=numshortout+1
122        idump(1,numshortout)=nint(xlon*180.)
123        idump(2,numshortout)=nint(ylat*360.)
124        zlim=min(ztra1(i)+topo,32766.)
125        idump(3,numshortout)=nint(zlim)
126        i4dump(numshortout)=npoint(i)
127      endif
128
129    endif
130  end do
131
132
133  ! Open output file and write the output
134  !**************************************
135
136  open(unitshortpart,file=path(2)(1:length(2))//'shortposit_'//adate// &
137       atime,form='unformatted')
138
139  ! Write current time to file
140  !***************************
141
142  write(unitshortpart) itime
143  write(unitshortpart) numshortout
144  write(unitshortpart) &
145       (i4dump(i),(idump(j,i),j=1,3),i=1,numshortout)
146
147
148  write(*,*) numshortout,numshortall
149
150  close(unitshortpart)
151
152end subroutine partoutput_short
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG