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

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

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

Revision 1.2 - (hide annotations) (download)
Tue Jun 24 16:07:07 2003 UTC (20 years, 11 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 heimbach 1.2 #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