/[MITgcm]/MITgcm/pkg/ctrl/ctrl_smooth.F
ViewVC logotype

Contents of /MITgcm/pkg/ctrl/ctrl_smooth.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (show annotations) (download)
Tue Oct 9 00:00:01 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint59j, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.2: +3 -0 lines 
add missing cvs $Header:$ or $Name:$
1 C $Header: $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 subroutine ctrl_smooth (
7 U fld ,mask)
8
9 c Apply horizontal smoothing to global _RL 2-D array
10
11 IMPLICIT NONE
12 #include "SIZE.h"
13
14 c input
15 c bi, bj : array indices
16 c k : vertical index used for masking
17 integer k, bi, bj
18 integer itlo,ithi
19 integer jtlo,jthi
20
21 c input/output
22 c fld : 2-D array to be smoothed
23 _RL fld( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy ,nSx,nSy)
24 _RL mask( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nr,nSx,nSy )
25
26
27 c local
28 integer i, j, im1, ip1, jm1, jp1
29 _RL tempVar
30 _RL fld_tmp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
31
32 integer imin , imax , jmin , jmax
33 parameter(imin=2-OLx, imax=sNx+OLx-1, jmin=2-OLy, jmax=sNy+OLy-1)
34
35 _RL p0 , p5 , p25 , p125 , p0625
36 parameter( p0=0.0, p5=0.5, p25=0.25, p125=0.125, p0625=0.0625 )
37 jtlo = 1
38 jthi = nsy
39 itlo = 1
40 ithi = nsx
41 k=1
42 do bj = jtlo,jthi
43 do bi = itlo,ithi
44 DO j = jmin, jmax
45 jm1 = j-1
46 jp1 = j+1
47 DO i = imin, imax
48 im1 = i-1
49 ip1 = i+1
50 tempVar =
51 & p25 * mask(i ,j ,k,bi,bj) +
52 & p125 * ( mask(im1,j ,k,bi,bj) +
53 & mask(ip1,j ,k,bi,bj) +
54 & mask(i ,jm1,k,bi,bj) +
55 & mask(i ,jp1,k,bi,bj) ) +
56 & p0625 * ( mask(im1,jm1,k,bi,bj) +
57 & mask(im1,jp1,k,bi,bj) +
58 & mask(ip1,jm1,k,bi,bj) +
59 & mask(ip1,jp1,k,bi,bj) )
60 IF ( tempVar .GE. p25 ) THEN
61 fld_tmp(i,j) = (
62 & p25 * fld(i ,j,bi,bj )*mask(i ,j ,k,bi,bj) +
63 & p125 *(fld(im1,j ,bi,bj )*mask(im1,j ,k,bi,bj) +
64 & fld(ip1,j ,bi,bj )*mask(ip1,j ,k,bi,bj) +
65 & fld(i ,jm1,bi,bj)*mask(i ,jm1,k,bi,bj) +
66 & fld(i ,jp1,bi,bj)*mask(i ,jp1,k,bi,bj))+
67 & p0625*(fld(im1,jm1,bi,bj)*mask(im1,jm1,k,bi,bj) +
68 & fld(im1,jp1,bi,bj)*mask(im1,jp1,k,bi,bj) +
69 & fld(ip1,jm1,bi,bj)*mask(ip1,jm1,k,bi,bj) +
70 & fld(ip1,jp1,bi,bj)*mask(ip1,jp1,k,bi,bj)))
71 & / tempVar
72 ELSE
73 fld_tmp(i,j) = fld(i,j,bi,bj)
74 ENDIF
75 ENDDO
76 ENDDO
77
78 c transfer smoothed field to output array
79 DO j = jmin, jmax
80 DO i = imin, imax
81 fld(i,j,bi,bj) = fld_tmp(i,j)
82 ENDDO
83 ENDDO
84 ENDDO
85 ENDDO
86
87
88 return
89 end
  ViewVC Help
Powered by ViewVC 1.1.22