[cdftools] 56/228: RD : add hanning on cdfsmooth.f90 , different computation in cdfhdy.f90 and cosmetics in cdfprofile.f90
Alastair McKinstry
mckinstry at moszumanska.debian.org
Fri Jun 12 08:21:28 UTC 2015
This is an automated email from the git hooks/post-receive script.
mckinstry pushed a commit to branch master
in repository cdftools.
commit a686b1ed9bb6e1d169fe6c35f5ae410877aa505a
Author: dussin <dussin at 1055176f-818a-41d9-83e1-73fbe5b947c5>
Date: Thu Jun 10 14:58:37 2010 +0000
RD : add hanning on cdfsmooth.f90 , different computation in cdfhdy.f90 and cosmetics in cdfprofile.f90
git-svn-id: http://servforge.legi.grenoble-inp.fr/svn/CDFTOOLS/trunk@332 1055176f-818a-41d9-83e1-73fbe5b947c5
---
cdfhdy.f90 | 10 ++++++---
cdfprofile.f90 | 1 -
cdfsmooth.f90 | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
3 files changed, 73 insertions(+), 6 deletions(-)
diff --git a/cdfhdy.f90 b/cdfhdy.f90
index b891314..d52c3c1 100644
--- a/cdfhdy.f90
+++ b/cdfhdy.f90
@@ -32,7 +32,7 @@ PROGRAM cdfhdy
& zsig , & !: potential density (sig-0)
& zmask , & !: 2D mask at current level
& zhdy, zterm, zdep, zdepth, zssh
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
+ REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim, ze3t_1d
CHARACTER(LEN=256) :: cfilet , cdum, cfileout='cdfhdy.nc', cmask='mask.nc' !:
CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc'
@@ -83,7 +83,7 @@ PROGRAM cdfhdy
ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig(npiglo,npjglo) , zhdy(npiglo,npjglo), zterm(npiglo,npjglo))
- ALLOCATE (zdep(npiglo,npjglo), zdepth(npiglo,npjglo), zssh(npiglo,npjglo))
+ ALLOCATE (zdep(npiglo,npjglo), zdepth(npiglo,npjglo), zssh(npiglo,npjglo), ze3t_1d(npk))
ALLOCATE (tim(npt))
! create output fileset
@@ -100,6 +100,8 @@ PROGRAM cdfhdy
zsal0(:,:)=35.
zmask(:,:) = getvar(cmask, 'tmask', zlev2, npiglo, npjglo)
+ ze3t_1d(:) = getvare3(coordzgr, 'e3t',npk)
+! PRINT *, 'e3t = ', ze3t_1d
DO jt=1,npt
PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
@@ -109,7 +111,9 @@ PROGRAM cdfhdy
DO jk = zlev1, zlev2
- zdep(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
+! zdep(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
+ ! we degrade the computation to smooth the results
+ zdep(:,:) = ze3t_1d(jk)
! total depth at current level (used for computation of rho in situ)
zdepth(:,:) = zdepth(:,:) + zdep(:,:)
diff --git a/cdfprofile.f90 b/cdfprofile.f90
index 1339601..70a6da8 100644
--- a/cdfprofile.f90
+++ b/cdfprofile.f90
@@ -86,7 +86,6 @@ PROGRAM cdfprofile
cvarname(:)=getvarname(cfile,nvars,typvar_input)
DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
IF ( cvarname(jvar) == cvar ) THEN
typvar=typvar_input(jvar)
ENDIF
diff --git a/cdfsmooth.f90 b/cdfsmooth.f90
index a7197d6..b30dddc 100644
--- a/cdfsmooth.f90
+++ b/cdfsmooth.f90
@@ -35,6 +35,7 @@ PROGRAM cdfsmooth
REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d,w2d !: raw data, filtered result
REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h !: depth
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: ec,e !: weigh in r8, starting index 0 :nband
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: ec2d
REAL(KIND=4) :: fn, spval
!
CHARACTER(LEN=256) :: cfile,cnom, cfilout, cdep, ctim
@@ -85,6 +86,7 @@ PROGRAM cdfsmooth
PRINT *,' Working with Lanczos filter'
CASE ( 'Hanning','H','h')
nfilter=2
+ ALLOCATE ( ec2d(0:2,0:2) )
WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'H',ncoup
PRINT *,' Working with Hanning filter'
CASE ( 'Shapiro','S','s')
@@ -197,7 +199,7 @@ CONTAINS
CASE ( 1 )
CALL lislanczos2d(px,kpx,py,npiglo,npjglo,fn,nband,npiglo,npjglo)
CASE ( 2 )
- print *,' not available'
+ CALL lishan2d(px,iw,py,ncoup,npiglo,npjglo)
CASE ( 3 )
print *,' not available'
CASE ( 4 )
@@ -234,7 +236,20 @@ CONTAINS
SUBROUTINE inithann(pfn,knj)
INTEGER, INTENT(in) :: knj !: bandwidth
REAL(KIND=4),INTENT(in) :: pfn
- PRINT *,' Init hann not done already' ; STOP
+ REAL(KIND=4) :: zsum
+
+ ec2d(:,:) = 0.
+ ! central point
+ ec2d(1,1) = 4.
+ ! along one direction
+ ec2d(1,0) = 1. ; ec2d(1,2) = 1.
+ ! and the other
+ ec2d(0,1) = 1. ; ec2d(2,1) = 1.
+
+ ! normalize
+ zsum = SUM(ec2d)
+ ec2d(:,:) = ec2d(:,:) / zsum
+
END SUBROUTINE inithann
SUBROUTINE initshap(pfn,knj)
@@ -338,6 +353,55 @@ CONTAINS
!
END SUBROUTINE lislanczos2d
+ SUBROUTINE lishan2d(px,kiw,py,order,kpi,kpj)
+ !----------------------------------------------
+ ! px = input data
+ ! kiw = validity of input data
+ ! py = output filter
+ ! n=number of input/output data
+ !--------------------------------------------
+ ! * Arguments
+ INTEGER, INTENT(in) :: kpi, kpj, order
+ INTEGER,DIMENSION(:,:),INTENT(in) :: kiw
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
+
+ ! local
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmp
+ INTEGER :: jiplus1, jiminus1, jjplus1, jjminus1
+ INTEGER :: jj, ji, iorder !: loop indexes
+
+ ! init the arrays
+ ALLOCATE( tmp(kpi,kpj) )
+ py(:,:) = 0.
+ tmp(:,:) = px(:,:)
+
+ DO iorder=1,order
+
+ DO jj=2,kpj-1
+ DO ji=2,kpi-1
+
+ !treatment of the domain frontiers
+ jiplus1 = MIN(ji+1,kpi) ; jiminus1 = MAX(ji-1,1)
+ jjplus1 = MIN(jj+1,kpj) ; jjminus1 = MAX(jj-1,1)
+
+ ! we don't compute in land
+ IF ( kiw(ji,jj) == 1 ) THEN
+
+ py(ji,jj) = SUM( ec2d(:,:) * tmp(jiminus1:jiplus1,jjminus1:jjplus1) )
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ ! update the tmp array
+ tmp(:,:) = py(:,:)
+
+ ENDDO
+
+ END SUBROUTINE lishan2d
+
SUBROUTINE lisbox(px,kiw,py,knx,kny,pfn,knj,kpi,kpj)
!----------------------------------------------
! perform a box car 2d filtering, of span knj
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/cdftools.git
More information about the debian-science-commits
mailing list