source: branches/jerome/src_flexwrf_v3.1/writeheader_nest.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: 8.7 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
24subroutine writeheader_nest
25
26  !*****************************************************************************
27  !                                                                            *
28  !  This routine produces a file header containing basic information on the   *
29  !  settings of the FLEXPART run.                                             *
30  !  The header file is essential and must be read in by any postprocessing    *
31  !  program before reading in the output data.                                *
32  !                                                                            *
33  !     Author: A. Stohl                                                       *
34  !                                                                            *
35  !     7 August 2002                                                          *
36  !                                                                            *
37  !*****************************************************************************
38  !                                                                            *
39  ! Variables:                                                                 *
40  !                                                                            *
41  ! xlon                   longitude                                           *
42  ! xl                     model x coordinate                                  *
43  ! ylat                   latitude                                            *
44  ! yl                     model y coordinate                                  *
45  !                                                                            *
46  !*****************************************************************************
47
48  use point_mod
49  use outg_mod
50  use par_mod
51  use com_mod
52
53  implicit none
54
55  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
56  real :: xp1,yp1,xp2,yp2
57  real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
58
59
60  !************************
61  ! Open header output file
62  !************************
63
64  open(unitheader,file=path(1)(1:length(1))//'header_nest', &
65       form='unformatted',err=998)
66
67
68  ! Write the header information
69  !*****************************
70
71  if (ldirect.eq.1) then
72!   write(unitheader) ibdate,ibtime,'FLEXWRF  V2.1'
73  if (outgrid_option .eq. 1) then
74    write(unitheader) ibdate,ibtime,'FLEXWRF lalo '
75  else
76  if (map_proj_id.eq.1) write(unitheader) ibdate,ibtime,'FLEXWRF lamb '
77  if (map_proj_id.eq.2) write(unitheader) ibdate,ibtime,'FLEXWRF ster '
78  if (map_proj_id.eq.3) write(unitheader) ibdate,ibtime,'FLEXWRF merc '
79  if (map_proj_id.eq.4) write(unitheader) ibdate,ibtime,'FLEXWRF glob '
80  endif
81
82  else
83!   write(unitheader) iedate,ietime,'FLEXWRF  V2.1'
84  if (outgrid_option .eq. 1) then
85    write(unitheader) iedate,ietime,'FLEXWRF lalo '
86  else
87  if (map_proj_id.eq.1) write(unitheader) iedate,ietime,'FLEXWRF lamb '
88  if (map_proj_id.eq.2) write(unitheader) iedate,ietime,'FLEXWRF ster '
89  if (map_proj_id.eq.3) write(unitheader) iedate,ietime,'FLEXWRF merc '
90  if (map_proj_id.eq.4) write(unitheader) iedate,ietime,'FLEXWRF glob '
91  endif
92
93  endif
94
95  ! Write info on output interval, averaging time, sampling time
96  !*************************************************************
97
98  write(unitheader) loutstep,loutaver,loutsample
99
100  ! Write information on output grid setup
101  !***************************************
102
103  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
104       dxoutn,dyoutn
105  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
106
107  call caldate(bdate,jjjjmmdd,ihmmss)
108  write(unitheader) jjjjmmdd,ihmmss
109
110  ! Write number of species, and name for each species (+extra name for depositions)
111  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
112  ! concentration fields
113  !*****************************************************************************
114
115  write(unitheader) 3*nspec,maxpointspec_act
116  do i=1,nspec
117    write(unitheader) 1,'WD_'//species(i)(1:7)
118    write(unitheader) 1,'DD_'//species(i)(1:7)
119    write(unitheader) numzgrid,species(i)
120  end do
121
122  ! Write information on release points: total number, then for each point:
123  ! start, end, coordinates, # of particles, name, mass
124  !************************************************************************
125
126  write(unitheader) numpoint
127  do i=1,numpoint
128    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
129    xp1=xpoint1(i)*dx+xlon0
130    yp1=ypoint1(i)*dy+ylat0
131    xp2=xpoint2(i)*dx+xlon0
132    yp2=ypoint2(i)*dy+ylat0
133    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
134    write(unitheader) npart(i),1
135    if (numpoint.le.2000) then
136      write(unitheader) compoint(i)
137    else
138      write(unitheader) compoint(2001)
139   endif
140    do j=1,nspec
141      write(unitheader) xmass(i,j)
142      write(unitheader) xmass(i,j)
143      write(unitheader) xmass(i,j)
144    end do
145  end do
146
147  ! Write information on some model switches
148  !*****************************************
149
150  write(unitheader) method,lsubgrid,lconvection, &
151       ind_source,ind_receptor
152
153  ! Write age class information
154  !****************************
155
156  write(unitheader) nageclass,(lage(i),i=1,nageclass)
157
158
159  ! Write topography to output file
160  !********************************
161
162  do ix=0,numxgridn-1
163    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
164  end do
165  close(unitheader)
166
167      open(53,file=path(1)(1:length(1))//'latlon_nest.txt' &
168          ,form='formatted')
169      open(54,file=path(1)(1:length(1))//'latlon_corner_nest.txt' &
170          ,form='formatted')
171
172      if (outgrid_option.eq.0) then ! irregular
173        call ll_to_xymeter_wrf(outgridn_swlon,outgridn_swlat,xsw,ysw)
174        call ll_to_xymeter_wrf(outgridn_nelon,outgridn_nelat,xne,yne)
175        do jy=1,numygridn
176        do ix=1,numxgridn
177          tmpx=out_xm0n+(float(ix)-0.5)*dxoutn
178          tmpy=out_ym0n+(float(jy)-0.5)*dyoutn
179          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
180        write(53,*) tmplon,tmplat
181          tmpx=out_xm0n+(float(ix)-1.)*dxoutn
182          tmpy=out_ym0n+(float(jy)-1.)*dyoutn
183          call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
184           write(54,*) tmplon,tmplat
185        enddo
186        enddo
187       else ! regular
188        call ll_to_xymeter_wrf(outgridn_swlon,outgridn_swlat,xsw,ysw)
189        call ll_to_xymeter_wrf(outgridn_nelon,outgridn_nelat,xne,yne)
190        do jy=1,numygridn
191        do ix=1,numxgridn
192          tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgridn-1)
193          tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygridn-1)
194          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
195            xl2=outlon0n+(float(ix)-0.5)*dxoutln !long 
196            yl2=outlat0n+(float(jy)-0.5)*dyoutln !lat 
197           write(53,*) xl2,yl2
198            xl2=outlon0n+float(ix-1)*dxoutln !long
199            yl2=outlat0n+float(jy-1)*dyoutln !lat   
200           write(54,*) xl2,yl2
201        enddo
202        enddo
203      endif
204
205
206      close(53)
207      close(54)
208
209
210  return
211
212
213998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
214  write(*,*) ' #### '//path(1)(1:length(1))//'header'//' #### '
215  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
216  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
217  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
218  stop
219
220end subroutine writeheader_nest
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG