source: flexpart.git/src/readOHfield.f90

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bug
Last change on this file was 92fab65, checked in by Ignacio Pisso <ip@…>, 4 years ago

add SPDX-License-Identifier to all .f90 files

  • Property mode set to 100644
File size: 3.1 KB
Line 
1! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
2! SPDX-License-Identifier: GPL-3.0-or-later
3
4subroutine readOHfield
5
6!*****************************************************************************
7!                                                                            *
8! Reads the OH field into memory                                             *
9!                                                                            *
10! AUTHOR: R.L. Thompson, Nov 2014                                            *
11!                                                                            *
12! UPDATES:                                                                   *
13!   03/2018 SEC: Converted original netCDF files to binary format            *
14!*****************************************************************************
15!                                                                            *
16! Variables:                                                                 *
17!                                                                            *
18! path(numpath)              contains the path names                         *
19! lonOH(nxOH)                longitude of OH fields                          *
20! latOH(nyOH)                latitude of OH fields                           *
21! altOH(nzOH)                altitude of OH fields                           *
22! etaOH(nzOH)                eta-levels of OH fields                         *
23! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3)                *
24!                                                                            *
25!                                                                            *
26!*****************************************************************************
27
28  use oh_mod
29  use par_mod
30  use com_mod
31
32  implicit none
33
34  integer :: i,j,k,l,ierr
35  real, dimension(:), allocatable :: etaOH
36
37!  real, parameter :: gasct=8.314   ! gas constant
38!  real, parameter :: mct=0.02894   ! kg mol-1
39!  real, parameter :: g=9.80665     ! m s-2
40!  real, parameter :: lrate=0.0065  ! K m-1
41  real, parameter :: scalehgt=7000. ! scale height in metres
42
43
44  open(unitOH,file=trim(ohfields_path) &
45       //'OH_FIELDS/OH_variables.bin',status='old', &
46       form='UNFORMATTED', iostat=ierr, convert='little_endian')
47
48  if(ierr.ne.0) then
49    write(*,*) 'Cannot read binary OH fields in ',trim(ohfields_path)//'OH_FIELDS/OH_variables.bin'
50    stop
51  endif
52
53  read(unitOH) nxOH
54  read(unitOH) nyOH
55  read(unitOH) nzOH
56  write(*,*) nxOH,nyOH,nzOH
57
58! allocate variables
59  allocate(lonOH(nxOH))
60  allocate(latOH(nyOH))
61  allocate(etaOH(nzOH))
62  allocate(altOH(nzOH))
63  allocate(OH_field(nxOH,nyOH,nzOH,12))
64  allocate(OH_hourly(nxOH,nyOH,nzOH,2))
65
66  read(unitOH) (lonjr(i),i=1,360)
67  read(unitOH) (latjr(i),i=1,180)
68  read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12)
69  read(unitOH) (lonOH(i),i=1,nxOH)
70  read(unitOH) (latOH(i),i=1,nyOH)
71  read(unitOH) (lonOH(i),i=1,nxOH)
72
73  read(unitOH) (altOH(i),i=1,nzOH)
74  read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12)
75  read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2)
76
77end subroutine readOHfield
78
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG