Commit 2159d7e8 authored by kbk's avatar kbk
Browse files

reads boundary values from 3D fields as individual columns

parent 5bc8206b
!$Id: ncdf_3d_bdy.F90,v 1.4 2003-04-23 11:54:03 kbk Exp $ !$Id: ncdf_3d_bdy.F90,v 1.5 2003-05-05 15:44:20 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -11,8 +11,8 @@ ...@@ -11,8 +11,8 @@
! !DESCRIPTION: ! !DESCRIPTION:
! !
! !USES: ! !USES:
use domain, only: imin,imax,jmin,jmax,kmax use domain, only: imin,imax,jmin,jmax,kmax,ioff,joff
use domain, only: nsbv,NWB,NNB,NEB,NSB use domain, only: nsbv,NWB,NNB,NEB,NSB,bdy_index
use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli
use domain, only: H use domain, only: H
use m2d, only: dtm use m2d, only: dtm
...@@ -41,7 +41,10 @@ ...@@ -41,7 +41,10 @@
! Original author(s): Karsten Bolding & Hans Burchard ! Original author(s): Karsten Bolding & Hans Burchard
! !
! $Log: ncdf_3d_bdy.F90,v $ ! $Log: ncdf_3d_bdy.F90,v $
! Revision 1.4 2003-04-23 11:54:03 kbk ! Revision 1.5 2003-05-05 15:44:20 kbk
! reads boundary values from 3D fields as individual columns
!
! Revision 1.4 2003/04/23 11:54:03 kbk
! cleaned code + TABS to spaces ! cleaned code + TABS to spaces
! !
! Revision 1.3 2003/04/07 16:19:52 kbk ! Revision 1.3 2003/04/07 16:19:52 kbk
...@@ -95,7 +98,7 @@ ...@@ -95,7 +98,7 @@
REAL_4B, allocatable, dimension(:,:,:):: sdum,tdum REAL_4B, allocatable, dimension(:,:,:):: sdum,tdum
integer :: rc,err integer :: rc,err
integer :: i,j,k,l,n,id integer :: i,j,k,l,m,n,id
!EOP !EOP
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
!BOC !BOC
...@@ -185,55 +188,88 @@ ...@@ -185,55 +188,88 @@
if (rc /= 0) stop 'init_3d_bdy_ncdf: Error allocating memory (S_bdy_clim)' if (rc /= 0) stop 'init_3d_bdy_ncdf: Error allocating memory (S_bdy_clim)'
if (from_3d_fields) then if (from_3d_fields) then
start(1) = imin; edges(1) = imax-imin+1; ! we read each boundary column individually
start(2) = jmin; edges(2) = jmax-jmin+1; ! m counts the time
! l counts the boundary number
! k counts the number of the specific point
! MUST cover the same area as in topo.nc
edges(1) = 1;
edges(2) = 1;
start(3) = 1; edges(3) = dim_len(3); start(3) = 1; edges(3) = dim_len(3);
edges(4) = 1 edges(4) = 1
do l=1,time_len do m=1,time_len
start(4) = l start(4) = m
err = nf_get_vara_real(ncid,temp_id,start,edges,tdum)
if (err .ne. NF_NOERR) go to 10 l = 0
err = nf_get_vara_real(ncid,salt_id,start,edges,sdum)
if (err .ne. NF_NOERR) go to 10
k = 0
do n=1,NWB do n=1,NWB
l = l+1
k = bdy_index(l)
i = wi(n) i = wi(n)
do j=wfj(1),wlj(1) do j=wfj(n),wlj(n)
start(1) = i+ioff ; start(2) = j+joff
err = nf_get_vara_real(ncid,salt_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
S_bdy_clim(m,k,:))
err = nf_get_vara_real(ncid,temp_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
T_bdy_clim(m,k,:))
k = k+1 k = k+1
wrk(:) = sdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),S_bdy_clim(l,k,:))
wrk(:) = tdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),T_bdy_clim(l,k,:))
end do end do
end do end do
do n = 1,NNB do n = 1,NNB
l = l+1
k = bdy_index(l)
j = nj(n) j = nj(n)
do i = nfi(n),nli(n) do i = nfi(n),nli(n)
start(1) = i+ioff ; start(2) = j+joff
err = nf_get_vara_real(ncid,salt_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
S_bdy_clim(m,k,:))
err = nf_get_vara_real(ncid,temp_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
T_bdy_clim(m,k,:))
k = k+1 k = k+1
wrk(:) = sdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),S_bdy_clim(l,k,:))
wrk(:) = tdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),T_bdy_clim(l,k,:))
end do end do
end do end do
do n=1,NEB do n=1,NEB
l = l+1
k = bdy_index(l)
i = ei(n) i = ei(n)
do j=efj(1),elj(1) do j=efj(1),elj(1)
start(1) = i+ioff ; start(2) = j+joff
err = nf_get_vara_real(ncid,salt_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
S_bdy_clim(m,k,:))
err = nf_get_vara_real(ncid,temp_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
T_bdy_clim(m,k,:))
k = k+1 k = k+1
wrk(:) = sdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),S_bdy_clim(l,k,:))
wrk(:) = tdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),T_bdy_clim(l,k,:))
end do end do
end do end do
do n = 1,NSB do n = 1,NSB
l = l+1
k = bdy_index(l)
j = sj(n) j = sj(n)
do i = sfi(n),sli(n) do i = sfi(n),sli(n)
start(1) = i+ioff ; start(2) = j+joff
err = nf_get_vara_real(ncid,salt_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
S_bdy_clim(m,k,:))
err = nf_get_vara_real(ncid,temp_id,start,edges,wrk)
if (err .ne. NF_NOERR) go to 10
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:), &
T_bdy_clim(m,k,:))
k = k+1 k = k+1
wrk(:) = sdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),S_bdy_clim(l,k,:))
wrk(:) = tdum(i,j,:)
call interpol(zlev,wrk,H(i,j),kmax,hn(i,j,:),T_bdy_clim(l,k,:))
end do end do
end do end do
end do end do
...@@ -317,7 +353,10 @@ ...@@ -317,7 +353,10 @@
! Original author(s): Karsten Bolding & Hans Burchard ! Original author(s): Karsten Bolding & Hans Burchard
! !
! $Log: ncdf_3d_bdy.F90,v $ ! $Log: ncdf_3d_bdy.F90,v $
! Revision 1.4 2003-04-23 11:54:03 kbk ! Revision 1.5 2003-05-05 15:44:20 kbk
! reads boundary values from 3D fields as individual columns
!
! Revision 1.4 2003/04/23 11:54:03 kbk
! cleaned code + TABS to spaces ! cleaned code + TABS to spaces
! !
! Revision 1.3 2003/04/07 16:19:52 kbk ! Revision 1.3 2003/04/07 16:19:52 kbk
...@@ -333,13 +372,6 @@ ...@@ -333,13 +372,6 @@
! Introduced module ncdf_2d_bdy ! Introduced module ncdf_2d_bdy
! !
! !LOCAL VARIABLES: ! !LOCAL VARIABLES:
#if 0
integer,save :: i,n
integer,save :: j,k,indx
logical :: first=.true.
REALTYPE :: t
REALTYPE, save :: t1,t2= -_ONE_,loop0
#endif
integer :: err integer :: err
REALTYPE :: rat REALTYPE :: rat
integer :: monthsecs,prev,this,next integer :: monthsecs,prev,this,next
...@@ -370,6 +402,7 @@ ...@@ -370,6 +402,7 @@
+ rat*0.5*(T_bdy_clim(next,:,:)+T_bdy_clim(this,:,:)) + rat*0.5*(T_bdy_clim(next,:,:)+T_bdy_clim(this,:,:))
else else
end if end if
#if 0 #if 0
start(1) = 1 ; edges(1) = kmax+1 start(1) = 1 ; edges(1) = kmax+1
start(2) = 1 ; edges(2) = bdy_len start(2) = 1 ; edges(2) = bdy_len
......
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