/[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.9 - (show annotations) (download)
Tue Apr 17 23:51:22 2007 UTC (17 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint59, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint63h, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint62b, checkpoint61f, checkpoint61n, checkpoint59j, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.8: +1 -2 lines
Remove informative header EXF.h

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_filter_rl.F,v 1.8 2007/04/16 23:27:21 jmc 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_PARAM.h"
35
36 c == routine arguments ==
37
38 _RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
39 character*1 ckind
40 integer mythid
41
42 c == local variables ==
43
44 integer bi,bj
45 integer i,j
46 integer itlo,ithi
47 integer jtlo,jthi
48
49 c == end of interface ==
50
51 jtlo = mybylo(mythid)
52 jthi = mybyhi(mythid)
53 itlo = mybxlo(mythid)
54 ithi = mybxhi(mythid)
55
56 c Do not filter with pkg/seaice because of B/C-grid interpolation
57 IF ( .NOT. useSEAICE ) THEN
58
59 c filter forcing field array
60 do bj = jtlo,jthi
61 do bi = itlo,ithi
62
63 c Set undefined values to zero.
64 crg not necessary and
65 crg would require additional intermediate results in adjoint
66 crg do j = 1,sny
67 crg do i = 1,snx
68 crg if (arr(i,j,bi,bj) .le. exf_undef) then
69 crg arr(i,j,bi,bj) = 0. _d 0
70 crg endif
71 crg enddo
72 crg enddo
73
74 c Set land points to zero
75 if (ckind .eq. 's') then
76
77 do j = 1,sny
78 do i = 1,snx
79 if ( maskC(i,j,1,bi,bj) .eq. 0. ) then
80 arr(i,j,bi,bj) = 0. _d 0
81 endif
82 enddo
83 enddo
84
85 else if (ckind .eq. 'u') then
86
87 do j = 1,sny
88 do i = 1,snx
89 if ( maskW(i,j,1,bi,bj) .eq. 0. ) then
90 arr(i,j,bi,bj) = 0. _d 0
91 endif
92 enddo
93 enddo
94
95 else if (ckind .eq. 'v') then
96
97 do j = 1,sny
98 do i = 1,snx
99 if ( maskS(i,j,1,bi,bj) .eq. 0. ) then
100 arr(i,j,bi,bj) = 0. _d 0
101 endif
102 enddo
103 enddo
104
105 end if
106
107 enddo
108 enddo
109
110 ENDIF
111 c END IF ( .NOT. useSEAICE )
112
113 end

  ViewVC Help
Powered by ViewVC 1.1.22