source: trunk/src/writeheader_txt.f90 @ 20

Last change on this file since 20 was 20, checked in by igpis, 8 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