source: trunk/src/initial_cond_output.f90

Last change on this file was 4, checked in by mlanger, 10 years ago
File size: 6.7 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 initial_cond_output(itime)
23  !                                 i
24  !*****************************************************************************
25  !                                                                            *
26  !     Output of the initial condition sensitivity field.                     *
27  !                                                                            *
28  !     Author: A. Stohl                                                       *
29  !                                                                            *
30  !     24 May 1995                                                            *
31  !                                                                            *
32  !     13 April 1999, Major update: if output size is smaller, dump output    *
33  !                    in sparse matrix format; additional output of           *
34  !                    uncertainty                                             *
35  !                                                                            *
36  !     05 April 2000, Major update: output of age classes; output for backward*
37  !                    runs is time spent in grid cell times total mass of     *
38  !                    species.                                                *
39  !                                                                            *
40  !     17 February 2002, Appropriate dimensions for backward and forward runs *
41  !                       are now specified in file par_mod                    *
42  !                                                                            *
43  !     June 2006, write grid in sparse matrix with a single write command     *
44  !                in order to save disk space                                 *
45  !                                                                            *
46  !     2008 new sparse matrix format                                          *
47  !                                                                            *
48  !*****************************************************************************
49  !                                                                            *
50  ! Variables:                                                                 *
51  ! ncells          number of cells with non-zero concentrations               *
52  ! sparse          .true. if in sparse matrix format, else .false.            *
53  !                                                                            *
54  !*****************************************************************************
55
56  use unc_mod
57  use point_mod
58  use outg_mod
59  use par_mod
60  use com_mod
61
62  implicit none
63
64  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
65  real :: sp_fact,fact_recept
66  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
67  logical :: sp_zer
68  character(len=3) :: anspec
69
70
71  !*********************************************************************
72  ! Determine the standard deviation of the mean concentration or mixing
73  ! ratio (uncertainty of the output) and the dry and wet deposition
74  !*********************************************************************
75
76  do ks=1,nspec
77
78    write(anspec,'(i3.3)') ks
79    open(97,file=path(2)(1:length(2))//'grid_initial'// &
80         '_'//anspec,form='unformatted')
81    write(97) itime
82
83    do kp=1,maxpointspec_act
84
85      if (ind_rel.eq.1) then
86        fact_recept=rho_rel(kp)
87      else
88        fact_recept=1.
89      endif
90
91  !*******************************************************************
92  ! Generate output: may be in concentration (ng/m3) or in mixing
93  ! ratio (ppt) or both
94  ! Output the position and the values alternated multiplied by
95  ! 1 or -1, first line is number of values, number of positions
96  ! For backward simulations, the unit is seconds, stored in grid_time
97  !*******************************************************************
98
99  ! Write out dummy "wet and dry deposition" fields, to keep same format
100  ! as for concentration output
101      sp_count_i=0
102      sp_count_r=0
103      write(97) sp_count_i
104      write(97) (sparse_dump_i(i),i=1,sp_count_i)
105      write(97) sp_count_r
106      write(97) (sparse_dump_r(i),i=1,sp_count_r)
107      write(97) sp_count_i
108      write(97) (sparse_dump_i(i),i=1,sp_count_i)
109      write(97) sp_count_r
110      write(97) (sparse_dump_r(i),i=1,sp_count_r)
111
112
113  ! Write out sensitivity to initial conditions
114      sp_count_i=0
115      sp_count_r=0
116      sp_fact=-1.
117      sp_zer=.true.
118      do kz=1,numzgrid
119        do jy=0,numygrid-1
120          do ix=0,numxgrid-1
121            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
122              if (sp_zer.eqv..true.) then ! first non zero value
123                sp_count_i=sp_count_i+1
124                sparse_dump_i(sp_count_i)= &
125                     ix+jy*numxgrid+kz*numxgrid*numygrid
126                sp_zer=.false.
127                sp_fact=sp_fact*(-1.)
128              endif
129              sp_count_r=sp_count_r+1
130              sparse_dump_r(sp_count_r)=sp_fact* &
131                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
132            else ! concentration is zero
133              sp_zer=.true.
134            endif
135          end do
136        end do
137      end do
138      write(97) sp_count_i
139      write(97) (sparse_dump_i(i),i=1,sp_count_i)
140      write(97) sp_count_r
141      write(97) (sparse_dump_r(i),i=1,sp_count_r)
142
143
144    end do
145
146    close(97)
147
148  end do
149
150
151end subroutine initial_cond_output
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG