source: flexpart.git/src/partoutput_short_mpi.f90 @ 02095e3

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 02095e3 was 5f9d14a, checked in by Espen Sollum ATMOS <eso@…>, 9 years ago

Updated wet depo scheme

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