/[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.2 - (show annotations) (download)
Tue Jun 24 16:07:07 2003 UTC (20 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint51e_post, checkpoint51k_post, checkpoint57t_post, checkpoint57o_post, checkpoint52l_pre, checkpoint52e_pre, hrcube4, checkpoint58e_post, checkpoint57v_post, checkpoint52n_post, checkpoint52j_post, checkpoint53d_post, checkpoint58u_post, checkpoint58w_post, checkpoint54a_pre, checkpoint51o_pre, checkpoint57m_post, checkpoint55c_post, checkpoint54e_post, checkpoint52e_post, checkpoint57s_post, checkpoint51n_pre, checkpoint54a_post, checkpoint53c_post, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint51l_post, checkpoint57g_post, checkpoint51q_post, checkpoint57b_post, checkpoint57c_pre, checkpoint51j_post, checkpoint58r_post, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint57y_post, hrcube_1, checkpoint57e_post, branch-netcdf, checkpoint52d_pre, checkpoint52l_post, checkpoint55h_post, checkpoint58n_post, checkpoint51r_post, checkpoint58x_post, checkpoint52k_post, checkpoint52b_pre, checkpoint51a_post, checkpoint57g_pre, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint58t_post, checkpoint58h_post, checkpoint54d_post, checkpoint56c_post, checkpoint52m_post, checkpoint51c_post, checkpoint57y_pre, checkpoint55, checkpoint53a_post, checkpoint57f_pre, checkpoint57a_post, checkpoint54, checkpoint51f_pre, checkpoint58q_post, checkpoint54f_post, checkpoint53b_post, checkpoint55g_post, checkpoint51, checkpoint51o_post, checkpoint51p_post, checkpoint58j_post, checkpoint52a_pre, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint51i_post, checkpoint53, checkpoint52, checkpoint51f_post, checkpoint52d_post, eckpoint57e_pre, checkpoint51b_post, checkpoint51b_pre, checkpoint52a_post, checkpoint57h_done, checkpoint58f_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, branchpoint-genmake2, checkpoint57x_post, checkpoint57n_post, checkpoint52c_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57f_post, checkpoint58a_post, checkpoint51h_pre, checkpoint51l_pre, checkpoint58i_post, checkpoint57q_post, checkpoint51g_post, checkpoint58g_post, ecco_c52_e35, hrcube5, checkpoint58o_post, checkpoint57z_post, checkpoint57c_post, checkpoint58y_post, checkpoint55e_post, checkpoint58k_post, checkpoint51d_post, checkpoint52i_post, checkpoint52j_pre, checkpoint58v_post, checkpoint53f_post, checkpoint55a_post, checkpoint51t_post, checkpoint53d_pre, checkpoint54c_post, checkpoint58s_post, checkpoint58p_post, checkpoint51n_post, checkpoint57j_post, checkpoint58b_post, checkpoint57h_pre, checkpoint51i_pre, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, checkpoint57h_post, hrcube_2, hrcube_3, checkpoint56a_post, checkpoint51m_post, checkpoint51s_post, checkpoint55d_post
Branch point for: branch-nonh, branch-genmake2, tg2-branch, checkpoint51n_branch, netcdf-sm0
Changes since 1.1: +86 -0 lines 
Merging for c51 vs. e34
1 #include "CPP_OPTIONS.h"
2
3 subroutine ctrl_smooth (
4 U fld ,mask)
5
6 c Apply horizontal smoothing to global _RL 2-D array
7
8 IMPLICIT NONE
9 #include "SIZE.h"
10
11 c input
12 c bi, bj : array indices
13 c k : vertical index used for masking
14 integer k, bi, bj
15 integer itlo,ithi
16 integer jtlo,jthi
17
18 c input/output
19 c fld : 2-D array to be smoothed
20 _RL fld( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy ,nSx,nSy)
21 _RL mask( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nr,nSx,nSy )
22
23
24 c local
25 integer i, j, im1, ip1, jm1, jp1
26 _RL tempVar
27 _RL fld_tmp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
28
29 integer imin , imax , jmin , jmax
30 parameter(imin=2-OLx, imax=sNx+OLx-1, jmin=2-OLy, jmax=sNy+OLy-1)
31
32 _RL p0 , p5 , p25 , p125 , p0625
33 parameter( p0=0.0, p5=0.5, p25=0.25, p125=0.125, p0625=0.0625 )
34 jtlo = 1
35 jthi = nsy
36 itlo = 1
37 ithi = nsx
38 k=1
39 do bj = jtlo,jthi
40 do bi = itlo,ithi
41 DO j = jmin, jmax
42 jm1 = j-1
43 jp1 = j+1
44 DO i = imin, imax
45 im1 = i-1
46 ip1 = i+1
47 tempVar =
48 & p25 * mask(i ,j ,k,bi,bj) +
49 & p125 * ( mask(im1,j ,k,bi,bj) +
50 & mask(ip1,j ,k,bi,bj) +
51 & mask(i ,jm1,k,bi,bj) +
52 & mask(i ,jp1,k,bi,bj) ) +
53 & p0625 * ( mask(im1,jm1,k,bi,bj) +
54 & mask(im1,jp1,k,bi,bj) +
55 & mask(ip1,jm1,k,bi,bj) +
56 & mask(ip1,jp1,k,bi,bj) )
57 IF ( tempVar .GE. p25 ) THEN
58 fld_tmp(i,j) = (
59 & p25 * fld(i ,j,bi,bj )*mask(i ,j ,k,bi,bj) +
60 & p125 *(fld(im1,j ,bi,bj )*mask(im1,j ,k,bi,bj) +
61 & fld(ip1,j ,bi,bj )*mask(ip1,j ,k,bi,bj) +
62 & fld(i ,jm1,bi,bj)*mask(i ,jm1,k,bi,bj) +
63 & fld(i ,jp1,bi,bj)*mask(i ,jp1,k,bi,bj))+
64 & p0625*(fld(im1,jm1,bi,bj)*mask(im1,jm1,k,bi,bj) +
65 & fld(im1,jp1,bi,bj)*mask(im1,jp1,k,bi,bj) +
66 & fld(ip1,jm1,bi,bj)*mask(ip1,jm1,k,bi,bj) +
67 & fld(ip1,jp1,bi,bj)*mask(ip1,jp1,k,bi,bj)))
68 & / tempVar
69 ELSE
70 fld_tmp(i,j) = fld(i,j,bi,bj)
71 ENDIF
72 ENDDO
73 ENDDO
74
75 c transfer smoothed field to output array
76 DO j = jmin, jmax
77 DO i = imin, imax
78 fld(i,j,bi,bj) = fld_tmp(i,j)
79 ENDDO
80 ENDDO
81 ENDDO
82 ENDDO
83
84
85 return
86 end
  ViewVC Help
Powered by ViewVC 1.1.22