Commit 6ecdb08e authored by kbk's avatar kbk
Browse files

meteo point source forcing - taus, swr and shf - implemented

parent 18ac0921
!$Id: meteo.F90,v 1.9 2003-10-01 12:09:13 kbk Exp $
!$Id: meteo.F90,v 1.10 2004-01-15 11:45:00 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -82,7 +82,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: meteo.F90,v $
! Revision 1.9 2003-10-01 12:09:13 kbk
! Revision 1.10 2004-01-15 11:45:00 kbk
! meteo point source forcing - taus, swr and shf - implemented
!
! Revision 1.9 2003/10/01 12:09:13 kbk
! airp in HALO-zones - need in momentum eqs.
!
! Revision 1.8 2003/07/01 16:38:34 kbk
......@@ -139,8 +142,8 @@
REALTYPE :: swr_const= _ZERO_ ,shf_const= _ZERO_
REALTYPE, dimension(:,:), allocatable :: airp_old,tausx_old,tausy_old
REALTYPE, dimension(:,:), allocatable :: d_airp,d_tausx,d_tausy
REALTYPE, dimension(:,:), allocatable :: tcc_old,shf_old
REALTYPE, dimension(:,:), allocatable :: d_tcc,d_shf
REALTYPE, dimension(:,:), allocatable :: tcc_old,swr_old,shf_old
REALTYPE, dimension(:,:), allocatable :: d_tcc,d_swr,d_shf
!
! !TO DO:
! A method for stress calculations without knowledge of SST and meteorological
......@@ -292,6 +295,10 @@
if (rc /= 0) stop 'init_meteo: Error allocating memory (tcc_old)'
tcc_old = _ZERO_
allocate(swr_old(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_meteo: Error allocating memory (swr_old)'
swr_old = _ZERO_
allocate(shf_old(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_meteo: Error allocating memory (shf_old)'
shf_old = _ZERO_
......@@ -300,6 +307,10 @@
if (rc /= 0) stop 'init_meteo: Error allocating memory (d_tcc)'
d_tcc = _ZERO_
allocate(d_swr(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_meteo: Error allocating memory (d_swr)'
d_swr = _ZERO_
allocate(d_shf(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_meteo: Error allocating memory (d_shf)'
d_shf = _ZERO_
......@@ -478,11 +489,30 @@
end do
end do
else
airp = _ZERO_
tausx = ramp*tausx
tausy = ramp*tausy
swr = _ZERO_
shf = _ZERO_
if (first) then
tausx_old = tausx
tausy_old = tausy
swr_old = swr
shf_old = shf
end if
if (new_meteo) then
tausx_old = tausx_old + d_tausx
tausy_old = tausy_old + d_tausy
swr_old = swr_old + d_swr
shf_old = shf_old + d_shf
d_tausx = tausx - tausx_old
d_tausy = tausy - tausy_old
d_swr = swr - swr_old
d_shf = shf - shf_old
end if
if (.not. first) then
t_frac = (t-t_1)/(t_2-t_1)
tausx = tausx_old + t_frac*d_tausx
tausy = tausy_old + t_frac*d_tausy
swr = swr_old + t_frac*d_swr
shf = shf_old + t_frac*d_shf
end if
endif
case default
FATAL 'A non valid meteo method has been specified.'
......
!$Id: ncdf_meteo.F90,v 1.9 2003-12-16 16:50:41 kbk Exp $
!$Id: ncdf_meteo.F90,v 1.10 2004-01-15 11:45:01 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -35,6 +35,7 @@
integer :: tausx_id,tausy_id,swr_id,shf_id
integer :: iextr,jextr,textr,tmax=-1
integer :: grid_scan=1
logical :: point_source=.false.
REALTYPE, allocatable :: met_lon(:),met_lat(:)
REAL_4B, allocatable :: met_times(:)
......@@ -75,7 +76,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: ncdf_meteo.F90,v $
! Revision 1.9 2003-12-16 16:50:41 kbk
! Revision 1.10 2004-01-15 11:45:01 kbk
! meteo point source forcing - taus, swr and shf - implemented
!
! Revision 1.9 2003/12/16 16:50:41 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.8 2003/11/03 14:34:54 kbk
......@@ -170,6 +174,15 @@
call open_meteo_file(meteo_file)
if(iextr .eq. 1 .and. jextr .eq. 1) then
point_source = .true.
LEVEL3 'Assuming Point Source meteo forcing'
if (on_grid .eq. .false. ) then
LEVEL3 'Setting on_grid to true'
on_grid=.true.
end if
end if
allocate(wrk(iextr,jextr),stat=err)
if (err /= 0) stop 'ncdf_meteo: Error allocating memory (wrk)'
wrk = 0.
......@@ -203,23 +216,23 @@
#endif
call init_grid_interpol(imin,imax,jmin,jmax,az, &
lonc,latc,met_lon,met_lat,southpole,gridmap,ti,ui)
end if
LEVEL2 "Checking interpolation coefficients"
do j=jmin,jmax
do i=imin,imax
if ( az(i,j) .gt. 0 .and. &
(ui(i,j) .lt. _ZERO_ .or. ti(i,j) .lt. _ZERO_ )) then
ok=.false.
LEVEL3 "error at (i,j) ",i,j
end if
LEVEL2 "Checking interpolation coefficients"
do j=jmin,jmax
do i=imin,imax
if ( az(i,j) .gt. 0 .and. &
(ui(i,j) .lt. _ZERO_ .or. ti(i,j) .lt. _ZERO_ )) then
ok=.false.
LEVEL3 "error at (i,j) ",i,j
end if
end do
end do
end do
if ( ok ) then
LEVEL2 "done"
else
call getm_error("init_meteo_input_ncdf()", &
"Some interpolation coefficients are not valid")
if ( ok ) then
LEVEL2 "done"
else
call getm_error("init_meteo_input_ncdf()", &
"Some interpolation coefficients are not valid")
end if
end if
if (calc_met) then
......@@ -443,7 +456,8 @@
do
if (found) EXIT
read(iunit,*,err=85,end=90) fn
LEVEL3 'Trying meteo from: ',trim(fn)
LEVEL3 'Trying meteo from:'
LEVEL4 trim(fn)
err = nf_open(fn,NCNOWRIT,ncid)
if (err .ne. NF_NOERR) go to 10
......@@ -590,7 +604,8 @@
if (found) then
offset = TimeDiff(jul0,secs0,j1,s1)
LEVEL3 'Using meteo from: ',trim(fn)
LEVEL3 'Using meteo from:'
LEVEL4 trim(fn)
LEVEL3 'Meteorological offset time ',offset
else
FATAL 'Could not find any valid meteo-files'
......@@ -752,35 +767,51 @@
err = nf_get_vara_real(ncid,tausx_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
do j=jmin,jmax
do i=imin,imax
tausx(i,j) = wrk(i,j)
if (point_source) then
tausx = wrk(1,1)
else
do j=jmin,jmax
do i=imin,imax
tausx(i,j) = wrk(i,j)
end do
end do
end do
end if
err = nf_get_vara_real(ncid,tausy_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
do j=jmin,jmax
do i=imin,imax
tausy(i,j) = wrk(i,j)
if (point_source) then
tausy = wrk(1,1)
else
do j=jmin,jmax
do i=imin,imax
tausy(i,j) = wrk(i,j)
end do
end do
end do
end if
err = nf_get_vara_real(ncid,swr_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
do j=jmin,jmax
do i=imin,imax
swr(i,j) = wrk(i,j)
if (point_source) then
swr = wrk(1,1)
else
do j=jmin,jmax
do i=imin,imax
swr(i,j) = wrk(i,j)
end do
end do
end do
end if
err = nf_get_vara_real(ncid,shf_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
do j=jmin,jmax
do i=imin,imax
shf(i,j) = wrk(i,j)
if (point_source) then
shf = wrk(1,1)
else
do j=jmin,jmax
do i=imin,imax
shf(i,j) = wrk(i,j)
end do
end do
end do
end if
end if
......
Markdown is supported
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