source: trunk/src/writeheader_txt.f90 @ 28

Last change on this file since 28 was 20, checked in by igpis, 10 years ago

move version 9.1.8 form branches to trunk. Contributions from HSO, saeck, pesei, NIK, RT, XKF, IP and others

File size: 7.6 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 writeheader_txt
23
24  !*****************************************************************************
25  !                                                                            *
26  !  This routine produces a file header containing basic information on the   *
27  !  settings of the FLEXPART run.                                             *
28  !  The header file is essential and must be read in by any postprocessing    *
29  !  program before reading in the output data.                                *
30  !                                                                            *
31  !     Author: A. Stohl                                                       *
32  !                                                                            *
33  !     7 August 2002                                                          *
34  !     modified IP 2013 for text output                                       *
35  !*****************************************************************************
36  !                                                                            *
37  ! Variables:                                                                 *
38  !                                                                            *
39  ! xlon                   longitude                                           *
40  ! xl                     model x coordinate                                  *
41  ! ylat                   latitude                                            *
42  ! yl                     model y coordinate                                  *
43  !                                                                            *
44  !*****************************************************************************
45
46  use point_mod
47  use outg_mod
48  use par_mod
49  use com_mod
50
51  implicit none
52
53  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
54  real :: xp1,yp1,xp2,yp2
55
56
57  !************************
58  ! Open header output file
59  !************************
60
61  open(unitheader,file=path(2)(1:length(2))//'header_txt', &
62       form='formatted',err=998)
63  open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', &
64       form='formatted',err=998)
65
66
67  ! Write the header information
68  !*****************************
69 
70  write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion'
71  write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) !  'FLEXPART V9.0'
72  !if (ldirect.eq.1) then
73  !  write(unitheader,*) ibdate,ibtime,trim(flexversion) !  'FLEXPART V9.0'
74  !else
75  !  write(unitheader,*) iedate,ietime,trim(flexversion) ! 'FLEXPART V9.0'
76  !endif
77
78  ! Write info on output interval, averaging time, sampling time
79  !*************************************************************
80 
81  write(unitheader,*) '# interval, averaging time, sampling time'
82  write(unitheader,*) loutstep,loutaver,loutsample
83
84  ! Write information on output grid setup
85  !***************************************
86 
87  write(unitheader,*) '# information on grid setup    '
88  write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout'
89  write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, &
90       dxout,dyout 
91  write(unitheader,*) '# numzgrid, outheight(.) '
92  write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid)
93
94  write(unitheader,*) '# jjjjmmdd,ihmmss'
95  call caldate(bdate,jjjjmmdd,ihmmss)
96  write(unitheader,*) jjjjmmdd,ihmmss
97
98  ! Write number of species, and name for each species (+extra name for depositions)
99  ! Indicate the vertical dimension of the fields (i.e., 1 for deposition fields, numzgrid for
100  ! concentration fields
101  !*****************************************************************************
102
103  write(unitheader,*) '# information on species'
104  write(unitheader,*) '# 3*nspec,maxpointspec_act'
105  write(unitheader,*) 3*nspec,maxpointspec_act
106  write(unitheader,*) '# for nspec:'
107  write(unitheader,*) '# 1, WD_ '
108  write(unitheader,*) '# 1, DD_ '
109  write(unitheader,*) '# numzgrid,species'
110  do i=1,nspec
111    write(unitheader,*) 1,'WD_'//species(i)(1:7)
112    write(unitheader,*) 1,'DD_'//species(i)(1:7)
113    write(unitheader,*) numzgrid,species(i)
114  end do
115
116  ! Write information on release points: total number, then for each point:
117  ! start, end, coordinates, # of particles, name, mass
118  !************************************************************************
119
120
121  write(unitheader_txt,*) '# information on release points'
122  write(unitheader_txt,*) '# numpoint'
123  write(unitheader_txt,*) numpoint
124  write(unitheader_txt,*) '# for numpoint:'
125  do i=1,numpoint
126    write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i)
127    xp1=xpoint1(i)*dx+xlon0
128    yp1=ypoint1(i)*dy+ylat0
129    xp2=xpoint2(i)*dx+xlon0
130    yp2=ypoint2(i)*dy+ylat0
131    write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
132    write(unitheader_txt,*) npart(i),1
133    if (numpoint.le.1000) then
134      write(unitheader_txt,*) compoint(i)
135    else
136      write(unitheader_txt,*) compoint(1001)
137    endif
138    do j=1,nspec
139      write(unitheader_txt,*) xmass(i,j)
140      write(unitheader_txt,*) xmass(i,j)
141      write(unitheader_txt,*) xmass(i,j)
142    end do
143  end do
144
145  ! Write information on model switches
146  !*****************************************
147
148  write(unitheader,*) '# information on model switches'
149  write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor'
150  write(unitheader,*) method,lsubgrid,lconvection, &
151       ind_source,ind_receptor
152
153  ! Write age class information
154  !****************************
155 
156  write(unitheader,*) '# information on age class     '
157  write(unitheader,*) nageclass,(lage(i),i=1,nageclass)
158
159
160  !Do not write topography to text output file. Keep it on the binary one
161  !********************************
162
163  !do ix=0,numxgrid-1
164  !  write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1)
165  !end do
166
167
168 
169
170
171  close(unitheader)
172  close(unitheader_txt)
173
174
175!  open(unitheader,file=path(2)(1:length(2))//'header_nml', &
176!        form='formatted',err=998)
177!  write(unitheader,NML=COMMAND)
178!  close(unitheader)
179
180  return
181
182
183998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
184  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
185  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
186  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
187  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
188  stop
189
190end subroutine writeheader_txt
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG