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

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

Merged changes from CTBTO project

  • Property mode set to 100644
File size: 6.8 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_nest
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  !                                                                            *
35  !*****************************************************************************
36  !                                                                            *
37  !  Modified to remove TRIM around the output of flexversion so that          *
38  !  it will be a constant length (defined in com_mod.f90) in output header    *
39  !                                                                            *
40  !     Don Morton, Boreal Scientific Computing                                *
41  !     07 May 2017                                                            *
42  !                                                                            *
43  !*****************************************************************************
44  !                                                                            *
45  ! Variables:                                                                 *
46  !                                                                            *
47  ! xlon                   longitude                                           *
48  ! xl                     model x coordinate                                  *
49  ! ylat                   latitude                                            *
50  ! yl                     model y coordinate                                  *
51  !                                                                            *
52  !*****************************************************************************
53
54  use point_mod
55  use outg_mod
56  use par_mod
57  use com_mod
58
59  implicit none
60
61  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
62  real :: xp1,yp1,xp2,yp2
63
64
65  !************************
66  ! Open header output file
67  !************************
68
69  open(unitheader,file=path(2)(1:length(2))//'header_nest', &
70       form='unformatted',err=998)
71
72
73  ! Write the header information
74  !*****************************
75
76  if (ldirect.eq.1) then
77    write(unitheader) ibdate,ibtime, flexversion
78  else
79    write(unitheader) iedate,ietime, flexversion
80  endif
81
82  ! Write info on output interval, averaging time, sampling time
83  !*************************************************************
84
85  write(unitheader) loutstep,loutaver,loutsample
86
87  ! Write information on output grid setup
88  !***************************************
89
90  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
91       dxoutn,dyoutn
92  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
93
94  call caldate(bdate,jjjjmmdd,ihmmss)
95  write(unitheader) jjjjmmdd,ihmmss
96
97  ! Write number of species, and name for each species (+extra name for depositions)
98  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
99  ! concentration fields
100  !*****************************************************************************
101
102  write(unitheader) 3*nspec,maxpointspec_act
103  do i=1,nspec
104    write(unitheader) 1,'WD_'//species(i)(1:7)
105    write(unitheader) 1,'DD_'//species(i)(1:7)
106    write(unitheader) numzgrid,species(i)
107  end do
108
109  ! Write information on release points: total number, then for each point:
110  ! start, end, coordinates, # of particles, name, mass
111  !************************************************************************
112
113  write(unitheader) numpoint
114  do i=1,numpoint
115    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
116    xp1=xpoint1(i)*dx+xlon0
117    yp1=ypoint1(i)*dy+ylat0
118    xp2=xpoint2(i)*dx+xlon0
119    yp2=ypoint2(i)*dy+ylat0
120    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
121    write(unitheader) npart(i),1
122    if (numpoint.le.1000) then
123      write(unitheader) compoint(i)
124    else
125      write(unitheader) compoint(1001)
126   endif
127    do j=1,nspec
128      write(unitheader) xmass(i,j)
129      write(unitheader) xmass(i,j)
130      write(unitheader) xmass(i,j)
131    end do
132  end do
133
134  ! Write information on some model switches
135  !*****************************************
136
137  write(unitheader) method,lsubgrid,lconvection, &
138       ind_source,ind_receptor
139
140  ! Write age class information
141  !****************************
142
143  write(unitheader) nageclass,(lage(i),i=1,nageclass)
144
145
146  ! Write topography to output file
147  !********************************
148
149  do ix=0,numxgridn-1
150    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
151  end do
152  close(unitheader)
153
154  return
155
156
157998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
158  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
159  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
160  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
161  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
162  stop
163
164end subroutine writeheader_nest
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG