/[MITgcm]/MITgcm/pkg/exf/exf_filter_rl.F
ViewVC logotype

Contents of /MITgcm/pkg/exf/exf_filter_rl.F

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


Revision 1.8 - (show annotations) (download)
Mon Apr 16 23:27:21 2007 UTC (17 years, 1 month ago) by jmc
Branch: MAIN
Changes since 1.7: +4 -4 lines
move EXF header files from lower_case.h to UPPER_CASE.h ;
 add missing cvs Header & Name

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_filter_rl.F,v 1.7 2006/05/25 18:32:55 heimbach Exp $
2 C $Name: $
3
4 #include "EXF_OPTIONS.h"
5
6 subroutine exf_filter_rl(
7 I arr,
8 I ckind,
9 I mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE exf_filter_rl
14 c ==================================================================
15 c
16 c o Read a flux record for external forcing.
17 c
18 c started: Ralf.Giering@FastOpt.de 24-Mai-2000
19 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
20 c
21 c ==================================================================
22 c SUBROUTINE exf_filter_rl
23 c ==================================================================
24
25 implicit none
26
27 c == global variables ==
28
29 #include "EEPARAMS.h"
30 #include "SIZE.h"
31 #include "GRID.h"
32 #include "PARAMS.h"
33 #include "EXF_CONSTANTS.h"
34 #include "EXF.h"
35 #include "EXF_PARAM.h"
36
37 c == routine arguments ==
38
39 _RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
40 character*1 ckind
41 integer mythid
42
43 c == local variables ==
44
45 integer bi,bj
46 integer i,j
47 integer itlo,ithi
48 integer jtlo,jthi
49
50 c == end of interface ==
51
52 jtlo = mybylo(mythid)
53 jthi = mybyhi(mythid)
54 itlo = mybxlo(mythid)
55 ithi = mybxhi(mythid)
56
57 c Do not filter with pkg/seaice because of B/C-grid interpolation
58 IF ( .NOT. useSEAICE ) THEN
59
60 c filter forcing field array
61 do bj = jtlo,jthi
62 do bi = itlo,ithi
63
64 c Set undefined values to zero.
65 crg not necessary and
66 crg would require additional intermediate results in adjoint
67 crg do j = 1,sny
68 crg do i = 1,snx
69 crg if (arr(i,j,bi,bj) .le. exf_undef) then
70 crg arr(i,j,bi,bj) = 0. _d 0
71 crg endif
72 crg enddo
73 crg enddo
74
75 c Set land points to zero
76 if (ckind .eq. 's') then
77
78 do j = 1,sny
79 do i = 1,snx
80 if ( maskC(i,j,1,bi,bj) .eq. 0. ) then
81 arr(i,j,bi,bj) = 0. _d 0
82 endif
83 enddo
84 enddo
85
86 else if (ckind .eq. 'u') then
87
88 do j = 1,sny
89 do i = 1,snx
90 if ( maskW(i,j,1,bi,bj) .eq. 0. ) then
91 arr(i,j,bi,bj) = 0. _d 0
92 endif
93 enddo
94 enddo
95
96 else if (ckind .eq. 'v') then
97
98 do j = 1,sny
99 do i = 1,snx
100 if ( maskS(i,j,1,bi,bj) .eq. 0. ) then
101 arr(i,j,bi,bj) = 0. _d 0
102 endif
103 enddo
104 enddo
105
106 end if
107
108 enddo
109 enddo
110
111 ENDIF
112 c END IF ( .NOT. useSEAICE )
113
114 end

  ViewVC Help
Powered by ViewVC 1.1.22