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

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

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


Revision 1.7 - (show annotations) (download)
Thu May 25 18:32:55 2006 UTC (17 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58f_post, checkpoint58y_post, checkpoint58t_post, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58m_post, checkpoint58r_post, checkpoint58n_post, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.6: +4 -4 lines
o add new fields wspeed, snowprecip (to be able to couple to thsice)
o correct Stefan-Boltzmann constant
o new parameter for longwave surface emittance
o separate some stuff from exf_bulkformulae into new routines
  exf_radiation, exf_wind

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_filter_rs.F,v 1.6 2003/10/09 04:19:19 edhill Exp $
2
3 #include "EXF_OPTIONS.h"
4
5 subroutine exf_filter_rs(
6 I arr,
7 I ckind,
8 I mythid
9 & )
10
11 c ==================================================================
12 c SUBROUTINE exf_filter_rs
13 c ==================================================================
14 c
15 c o Read a flux record for external forcing.
16 c
17 c started: Ralf.Giering@FastOpt.de 24-Mai-2000
18 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
19 c
20 c ==================================================================
21 c SUBROUTINE exf_filter_rs
22 c ==================================================================
23
24 implicit none
25
26 c == global variables ==
27
28 #include "EEPARAMS.h"
29 #include "SIZE.h"
30 #include "GRID.h"
31 #include "PARAMS.h"
32 #include "exf_constants.h"
33 #include "exf.h"
34 #include "exf_param.h"
35
36 c == routine arguments ==
37
38 _RS 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