source: branches/jerome/src_flexwrf_v3.1/coordtrafo.f90 @ 16

Last change on this file since 16 was 16, checked in by jebri, 10 years ago

sources for flexwrf v3.1

File size: 5.3 KB
Line 
1!***********************************************************************
2!* Copyright 2012,2013                                                *
3!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
4!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
5!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
6!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
7!*                                                                     *
8!* This file is part of FLEXPART WRF                                   *
9!*                                                                     *
10!* FLEXPART is free software: you can redistribute it and/or modify    *
11!* it under the terms of the GNU General Public License as published by*
12!* the Free Software Foundation, either version 3 of the License, or   *
13!* (at your option) any later version.                                 *
14!*                                                                     *
15!* FLEXPART is distributed in the hope that it will be useful,         *
16!* but WITHOUT ANY WARRANTY; without even the implied warranty of      *
17!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
18!* GNU General Public License for more details.                        *
19!*                                                                     *
20!* You should have received a copy of the GNU General Public License   *
21!* along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
22!***********************************************************************
23      subroutine coordtrafo
24!**********************************************************************
25!                                                                     *
26! Note:  This is the FLEXPART_WRF version of subroutine coordtrafo.   *
27!                                                                     *
28!             FLEXPART MODEL SUBROUTINE COORDTRAFO                    *
29!                                                                     *
30!**********************************************************************
31!                                                                     *
32! AUTHOR:      G. WOTAWA                                              *
33! DATE:        1994-02-07                                             *
34! LAST UPDATE: 1996-05-18   A. STOHL                                  *
35!                                                                     *
36! Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables*
37! July 2012, J Brioude: modification following flexpart 9             *
38!**********************************************************************
39!                                                                     *
40! DESCRIPTION: This subroutine transforms x and y coordinates of      *
41! particle release points to grid coordinates.                        *
42!                                                                     *
43!**********************************************************************
44
45  use point_mod
46  use par_mod
47  use com_mod
48
49  implicit none
50
51  integer :: i,j,k
52
53      if (numpoint.eq.0) goto 30
54
55! TRANSFORM X- AND Y- COORDINATES OF STARTING POINTS TO GRID COORDINATES
56!***********************************************************************
57
58      do i=1,numpoint
59        xpoint1(i)=(xpoint1(i)-xmet0)/dx
60        xpoint2(i)=(xpoint2(i)-xmet0)/dx
61        ypoint1(i)=(ypoint1(i)-ymet0)/dy
62      ypoint2(i)=(ypoint2(i)-ymet0)/dy
63   end do
64
6515    continue
66
67
68! CHECK IF RELEASE POINTS ARE WITHIN DOMAIN
69!******************************************
70
71      do i=1,numpoint
72
73      if ((ypoint1(i).lt.1.e-6).or.(ypoint1(i).ge.real(nymin1)-1.e-6)  &
74      .or.(ypoint2(i).lt.1.e-6).or.(ypoint2(i).ge.real(nymin1)-1.e-6)  &
75      .or.(xpoint1(i).lt.1.e-6).or.(xpoint1(i).ge.real(nxmin1)-1.e-6) &
76      .or.(xpoint2(i).lt.1.e-6).or.(xpoint2(i).ge.real(nxmin1)-1.e-6)) then
77
78!      if ((ypoint1(i).lt.1.e-6).or.(ypoint1(i).ge.real(nymin1)-1.e-6) &
79!      .or.(ypoint2(i).lt.1.e-6).or.(ypoint2(i).ge.real(nymin1)-1.e-6) &
80!      .or.((.not.xglobal).and.((xpoint1(i).lt.1.e-6).or. &
81!      (xpoint1(i).ge.real(nxmin1)-1.e-6).or.(xpoint2(i).lt.1.e-6).or. &
82!      (xpoint2(i).ge.real(nxmin1)-1.e-6)))) then
83
84          write(*,*) ' NOTICE: RELEASE POINT OUT OF DOMAIN DETECTED.'
85          write(*,*) ' IT IS REMOVED NOW ... '
86!         write(*,*) ' COMMENT: ',compoint(i)
87
88          if (i.lt.numpoint) then
89            do j=i+1,numpoint
90              xpoint1(j-1)=xpoint1(j)
91              ypoint1(j-1)=ypoint1(j)
92              xpoint2(j-1)=xpoint2(j)
93              ypoint2(j-1)=ypoint2(j)
94              zpoint1(j-1)=zpoint1(j)
95              zpoint2(j-1)=zpoint2(j)
96              npart(j-1)=npart(j)
97           kindz(j-1)=kindz(j)
98          ireleasestart(j-1)=ireleasestart(j)
99           ireleaseend(j-1)=ireleaseend(j)
100           if (j.le.2000) compoint(j-1)=compoint(j)
101           do k=1,nspec
102             xmass(j-1,k)=xmass(j,k)
103          end do
104
105         enddo
106          endif
107
108          numpoint=numpoint-1
109          if (numpoint.gt.0) goto 15
110
111        endif
112  end do
113
11430    if (numpoint.eq.0) then
115        write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
116        write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
117        write(*,*) ' CHECK FILE RELEASES...'
118        stop
119      endif
120
121end subroutine coordtrafo
122 
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG