source: flexpart.git/src/initial_cond_output_inversion.f90 @ 2eefa58

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bug
Last change on this file since 2eefa58 was 2eefa58, checked in by Espen Sollum ATMOS <eso@…>, 5 years ago

Added Ronas changes for inversion output
  • Property mode set to 100644
File size: 8.2 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_inversion(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  integer :: jjjjmmdd, ihmmss
66  real(kind=dp) :: jul
67  real :: sp_fact,fact_recept
68  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
69  logical :: sp_zer,lexist
70  logical,save :: listart=.true.
71  logical,save,allocatable,dimension(:) :: listartrel
72  character :: adate*8,atime*6
73  character :: areldate*8,areltime*6
74  character(len=3) :: anspec
75
76  if(listart) then
77    allocate(listartrel(maxpointspec_act))
78    listartrel(:)=.true.
79  endif
80  print*, 'listartrel = ',listartrel
81
82  !*********************************************************************
83  ! Determine the standard deviation of the mean concentration or mixing
84  ! ratio (uncertainty of the output) and the dry and wet deposition
85  !*********************************************************************
86
87  do ks=1,nspec
88
89    write(anspec,'(i3.3)') ks
90
91    do kp=1,maxpointspec_act
92
93      ! calculate date of release
94      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
95      call caldate(jul,jjjjmmdd,ihmmss)
96      write(areldate,'(i8.8)') jjjjmmdd
97      write(areltime,'(i6.6)') ihmmss
98      print*, areldate//areltime
99
100      ! calculate date of field
101      jul=bdate+real(itime,kind=dp)/86400._dp
102      call caldate(jul,jjjjmmdd,ihmmss)
103      write(adate,'(i8.8)') jjjjmmdd
104      write(atime,'(i6.6)') ihmmss
105      print*, adate//atime
106
107      inquire(file=path(2)(1:length(2))//'grid_initial_'//areldate// &
108         areltime//'_'//anspec,exist=lexist)
109      if(lexist.and..not.listartrel(kp)) then
110        ! open and append to existing file
111        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
112             areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
113      else
114        ! open new file
115        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
116             areltime//'_'//anspec,form='unformatted',status='replace',action='write')
117      endif
118      write(97) jjjjmmdd
119      write(97) ihmmss
120
121      listartrel(kp)=.false.
122
123      if (ind_rel.eq.1) then
124        fact_recept=rho_rel(kp)
125      else
126        fact_recept=1.
127      endif
128
129  !*******************************************************************
130  ! Generate output: may be in concentration (ng/m3) or in mixing
131  ! ratio (ppt) or both
132  ! Output the position and the values alternated multiplied by
133  ! 1 or -1, first line is number of values, number of positions
134  ! For backward simulations, the unit is seconds, stored in grid_time
135  !*******************************************************************
136
137  ! Write out dummy "wet and dry deposition" fields, to keep same format
138  ! as for concentration output
139!      sp_count_i=0
140!      sp_count_r=0
141!      write(97) sp_count_i
142!      write(97) (sparse_dump_i(i),i=1,sp_count_i)
143!      write(97) sp_count_r
144!      write(97) (sparse_dump_r(i),i=1,sp_count_r)
145!      write(97) sp_count_i
146!      write(97) (sparse_dump_i(i),i=1,sp_count_i)
147!      write(97) sp_count_r
148!      write(97) (sparse_dump_r(i),i=1,sp_count_r)
149
150
151  ! Write out sensitivity to initial conditions
152      sp_count_i=0
153      sp_count_r=0
154      sp_fact=-1.
155      sp_zer=.true.
156      do kz=1,numzgrid
157        do jy=0,numygrid-1
158          do ix=0,numxgrid-1
159            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
160              if (sp_zer.eqv..true.) then ! first non zero value
161                sp_count_i=sp_count_i+1
162                sparse_dump_i(sp_count_i)= &
163                     ix+jy*numxgrid+kz*numxgrid*numygrid
164                sp_zer=.false.
165                sp_fact=sp_fact*(-1.)
166              endif
167              sp_count_r=sp_count_r+1
168              sparse_dump_r(sp_count_r)=sp_fact* &
169                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
170            else ! concentration is zero
171              sp_zer=.true.
172            endif
173          end do
174        end do
175      end do
176      write(97) sp_count_i
177      write(97) (sparse_dump_i(i),i=1,sp_count_i)
178      write(97) sp_count_r
179      write(97) (sparse_dump_r(i),i=1,sp_count_r)
180
181      close(97)
182
183    end do
184
185  end do
186
187  ! reset listart
188  if (listart) then
189    listart=.false.
190  endif
191
192end subroutine initial_cond_output_inversion
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG