source: flexpart.git/src/readOHfield.f90 @ b1e0742

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

OH files converted from netcdf to binary format

  • Property mode set to 100644
File size: 4.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 readOHfield
23
24!*****************************************************************************
25!                                                                            *
26! Reads the OH field into memory                                             *
27!                                                                            *
28! AUTHOR: R.L. Thompson, Nov 2014                                            *
29!                                                                            *
30! UPDATES:                                                                   *
31!   03/2018 SEC: Converted original netCDF files to binary format            *
32!*****************************************************************************
33!                                                                            *
34! Variables:                                                                 *
35!                                                                            *
36! path(numpath)              contains the path names                         *
37! lonOH(nxOH)                longitude of OH fields                          *
38! latOH(nyOH)                latitude of OH fields                           *
39! altOH(nzOH)                altitude of OH fields                           *
40! etaOH(nzOH)                eta-levels of OH fields                         *
41! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3)                *
42!                                                                            *
43!                                                                            *
44!*****************************************************************************
45
46  use oh_mod
47  use par_mod
48  use com_mod
49
50  implicit none
51
52  character(len=150) :: thefile
53  character(len=2) :: mm
54  integer :: nid,ierr,xid,yid,zid,vid,m
55  integer :: i,j,k,l
56  real, dimension(:), allocatable :: etaOH
57
58!  real, parameter :: gasct=8.314   ! gas constant
59!  real, parameter :: mct=0.02894   ! kg mol-1
60!  real, parameter :: g=9.80665     ! m s-2
61!  real, parameter :: lrate=0.0065  ! K m-1
62  real, parameter :: scalehgt=7000. ! scale height in metres
63
64
65  open(unitOH,file=trim(ohfields_path) &
66       //'OH_FIELDS/OH_variables.bin',status='old', &
67       form='UNFORMATTED', iostat=ierr, convert='little_endian')
68
69  if(ierr.ne.0) then
70    write(*,*) 'Cannot read binary OH fields in ',trim(ohfields_path)//'OH_FIELDS/OH_variables.bin'
71    stop
72  endif
73
74  read(unitOH) nxOH
75  read(unitOH) nyOH
76  read(unitOH) nzOH
77  write(*,*) nxOH,nyOH,nzOH
78
79! allocate variables
80  allocate(lonOH(nxOH))
81  allocate(latOH(nyOH))
82  allocate(etaOH(nzOH))
83  allocate(altOH(nzOH))
84  allocate(OH_field(nxOH,nyOH,nzOH,12))
85  allocate(OH_hourly(nxOH,nyOH,nzOH,2))
86
87  read(unitOH) (lonjr(i),i=1,360)
88  read(unitOH) (latjr(i),i=1,180)
89  read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12)
90  read(unitOH) (lonOH(i),i=1,nxOH)
91  read(unitOH) (latOH(i),i=1,nyOH)
92  read(unitOH) (lonOH(i),i=1,nxOH)
93
94  read(unitOH) (altOH(i),i=1,nzOH)
95  read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12)
96  read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2)
97  write(*,*) 'nzOH: ',nzOH,(altOH(i),i=1,nzOH)
98
99end subroutine readOHfield
100
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG