Commit 18a00b76 authored by Espen Sollum's avatar Espen Sollum
Browse files

work in progress on arrays for readwind

parent a1114354
......@@ -53,7 +53,6 @@
if (allocated(dumarray1D)) deallocate(dumarray1D)
!
allocate(dumarray1D(lendim_exp(1)))
! allocate(dumarray1D(0:lendim_exp(1)-1))
if (allocated(istart)) deallocate(istart)
allocate(istart(ndims))
if (allocated(icount)) deallocate(icount)
......
!**********************************************************************
! Copyright 2016 *
! Andreas Stohl, Massimo Cassiani, Petra Seibert, A. Frank, *
! Gerhard Wotawa, Caroline Forster, Sabine Eckhardt, John Burkhart, *
! Harald Sodemann *
! *
! This file is part of FLEXPART-NorESM *
! *
! FLEXPART-NorESM is free software: you can redistribute it *
! and/or modify *
! it under the terms of the GNU General Public License as published by*
! the Free Software Foundation, either version 3 of the License, or *
! (at your option) any later version. *
! *
! FLEXPART-NorESM is distributed in the hope that it will be useful, *
! but WITHOUT ANY WARRANTY; without even the implied warranty of *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
! GNU General Public License for more details. *
! *
! You should have received a copy of the GNU General Public License *
! along with FLEXPART-NorESM. *
! If not, see <http://www.gnu.org/licenses/>. *
!**********************************************************************
Function dewpoint(TK,Q,P)
!*****************************************************************************
! *
! This routine calculates dew point in kelvin *
! files from NorESM *
! *
! Author: *
! M. Cassiani 2016 *
! *
! *
!*****************************************************************************
! *
! Variables: *
! TK temperatur in kelvin *
! Q specific humidity *
! P Surface pressure *
!*****************************************************************************
implicit none
real(kind=4) :: TK,Q,P,es,t,e,dewpoint,a,b,c,dewpoint2
t=TK-273.15 !from kelvin to celsius
if (t.gt.0) then !from Campbell and Norman introduction to environmental BioPhysics 1998 p. 41-43
!considering t<0 above ice t>0 above water
a=611 !Pa
b=17.502 !
c=240.97 !
else
a=611 !Pa
b=21.87 !
c=265.5 !
end if
!es=a*exp(b*t/(t+c)) ! from Campbell and Norman, , springer verlag.
!es=exp(53.67957-6473.7/(t+273.16)-4.8451*log(t+273.16)) !saturation pressure
e=Q*P/0.622 !approximate partial pressure of water wapor in Pa, 0.622 is the ratio of molar mass of water and air
!also (1-0.622)e was considered negligible compared to P.
!u=e/es !relative humidity
dewpoint=(c*log(e/a)/(b-log(e/a)))+273.15 !from Campbell and Norman, see above
!dewpoint2=5.42*10**3/(log(2.53*10.**11*0.622/(Q*P))) !-273 !Rogers and Yau's "A Short Course in Cloud Physics"
end
!**********************************************************************
! Copyright 2016 *
! Andreas Stohl, Massimo Cassiani, Petra Seibert, A. Frank, *
! Gerhard Wotawa, Caroline Forster, Sabine Eckhardt, John Burkhart, *
! Harald Sodemann *
! *
! This file is part of FLEXPART-NorESM *
! *
! FLEXPART-NorESM is free software: you can redistribute it *
! and/or modify *
! it under the terms of the GNU General Public License as published by*
! the Free Software Foundation, either version 3 of the License, or *
! (at your option) any later version. *
! *
! FLEXPART-NorESM is distributed in the hope that it will be useful, *
! but WITHOUT ANY WARRANTY; without even the implied warranty of *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
! GNU General Public License for more details. *
! *
! You should have received a copy of the GNU General Public License *
! along with FLEXPART-NorESM. *
! If not, see <http://www.gnu.org/licenses/>. *
!**********************************************************************
Function dewpoint(TK,Q,P)
!*****************************************************************************
! *
! This routine calculates dew point in kelvin *
! files from NorESM *
! *
! Author: *
! M. Cassiani 2016 *
! *
! *
!*****************************************************************************
! *
! Variables: *
! TK temperatur in kelvin *
! Q specific humidity *
! P Surface pressure *
!*****************************************************************************
implicit none
real(kind=4) :: TK,Q,P,es,t,e,dewpoint,a,b,c,dewpoint2
t=TK-273.15 !from kelvin to celsius
if (t.gt.0) then !from Campbell and Norman introduction to environmental BioPhysics 1998 p. 41-43
!considering t<0 above ice t>0 above water
a=611 !Pa
b=17.502 !
c=240.97 !
else
a=611 !Pa
b=21.87 !
c=265.5 !
end if
!es=a*exp(b*t/(t+c)) ! from Campbell and Norman, , springer verlag.
!es=exp(53.67957-6473.7/(t+273.16)-4.8451*log(t+273.16)) !saturation pressure
e=Q*P/0.622 !approximate partial pressure of water wapor in Pa, 0.622 is the ratio of molar mass of water and air
!also (1-0.622)e was considered negligible compared to P.
!u=e/es !relative humidity
dewpoint=(c*log(e/a)/(b-log(e/a)))+273.15 !from Campbell and Norman, see above
!dewpoint2=5.42*10**3/(log(2.53*10.**11*0.622/(Q*P))) !-273 !Rogers and Yau's "A Short Course in Cloud Physics"
end
......@@ -17,8 +17,8 @@ LIBPATH = /usr/lib/
LNK = -o
CMPL = -c
LIBS = -lnetcdf -lnetcdff $(NCOPT)
FFLAGS = -O2 -g -m64 -cpp -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -ffree-form \
-fbacktrace $(NCOPT)
FFLAGS = -O0 -g -m64 -cpp -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -ffree-form \
-fbacktrace -fcheck=all $(NCOPT)
#FFLAGS = -O2 -cpp -fconvert=little-endian -frecord-marker=4 -ffree-form -mcmodel=medium \
-fbacktrace $(NCOPT)
LDFLAGS = $(FFLAGS) -L$(LIBPATH) -I$(INCPATH) $(LIBS)
......
......@@ -151,9 +151,10 @@ module par_mod
!*********************************************
! Maximum dimensions of the input mother grids
!*********************************************
!integer,parameter :: nxmax=145,nymax=97,nuvzmax=27,nwzmax=27,nzmax=27 !for NorESM with 1.875x2.5 grid: added by mc
integer,parameter :: nxmax=145,nymax=97,nuvzmax=27,nwzmax=27,nzmax=27 !for NorESM with 1.875x2.5 grid: added by mc
! integer,parameter :: nxmax=145,nymax=97,nuvzmax=33,nwzmax=33,nzmax=33 !for NorESM2
integer,parameter :: nxmax=288,nymax=192,nuvzmax=33,nwzmax=33,nzmax=33 !eso: test
! integer,parameter :: nxmax=144,nymax=96,nuvzmax=33,nwzmax=33,nzmax=33 !for NorESM2 eso
! integer,parameter :: nxmax=288,nymax=192,nuvzmax=33,nwzmax=33,nzmax=33 !eso: new
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=61,nwzmax=61,nzmax=61
!integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
......
......@@ -460,7 +460,10 @@
! do ix=0, nxfield-1
if (varname.eq.'PS') then
! ps_tplus1_and_min1(ix,jy,index)=dumarray3D_real(ix+1,jy+1,itime)/time_interval
ps_tplus1_and_min1(:,:,index)=dumarray3D_real(:,:,itime)/time_interval
write(*,*) 'shape(ps_tplus1_and_min1)',shape(ps_tplus1_and_min1)
write(*,*) 'shape(dumarray3D_real)', shape(dumarray3D_real)
ps_tplus1_and_min1(0:nxfield-2,0:nymin1-1,index)=dumarray3D_real(0:nxfield-2,0:nymin1-1, itime)/time_interval
end if
! end do
! end do
......
......@@ -478,8 +478,13 @@
goto 100
end if
else if (ndims.eq.4) then
iret = &
nf90_get_var( ncid, id_var, dumarray4D_real, istart, icount)
!iret = nf90_get_var( ncid, id_var, dumarray4D_real, istart, icount)
! set icount, istart for time dimesion=1
icount(4) = 1
istart(4) = itime
write(*,*)'icount',icount
write(*,*)'istart',istart
iret = nf90_get_var( ncid, id_var, dumarray3D_real, istart, icount)
if (iret .ne. nf90_noerr) then
write(*,9100) 'error inquiring var value ' // varname, fnamenc
ierr = -5
......@@ -545,8 +550,12 @@
v10(:,:,1,n)=dumarray3D_real(:,:,itime)
end if
else if (varname.eq.'QREFHT') then !
td2(:,:,1,n)=dewpoint(tt2(:,:,1,n), &
dumarray3D_real(:,:,itime),ps(:,:,1,n))
do jy=0,nymin1
do ix=0, nxfield-1
td2(ix,jy,1,n)=dewpoint(tt2(ix,jy,1,n), &
dumarray3D_real(ix,jy,itime),ps(ix,jy,1,n))
end do
end do
qv2(:,:,1,n)=dumarray3D_real(:,:,itime)
!else if (varname.eq.'SOLARRADIATION') then !
! ssr(:,:,1,n)=
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment