GCC Code Coverage Report

Directory: ./
File: dyn3d_common/extrapol.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 93 0.0%
Branches: 0 68 0.0%
Line Branch Exec Source
1 !
2 ! $Id: extrapol.F 1952 2014-01-28 13:05:47Z lguez $
3 !
4 C
5 C
6 ✗ SUBROUTINE extrapol (pfild, kxlon, kylat, pmask,
7 ✗ . norsud, ldper, knbor, pwork)
8 IMPLICIT none
9 c
10 c OASIS routine (Adaptation: Laurent Li, le 14 mars 1997)
11 c Fill up missed values by using the neighbor points
12 c
13 INTEGER kxlon, kylat ! longitude and latitude dimensions (Input)
14 INTEGER knbor ! minimum neighbor number (Input)
15 LOGICAL norsud ! True if field is from North to South (Input)
16 LOGICAL ldper ! True if take into account the periodicity (Input)
17 REAL pmask ! mask value (Input)
18 REAL pfild(kxlon,kylat) ! field to be extrapolated (Input/Output)
19 REAL pwork(kxlon,kylat) ! working space
20 c
21 REAL zwmsk
22 INTEGER incre, idoit, i, j, k, inbor, ideb, ifin, ilon, jlat
23 INTEGER ix(9), jy(9) ! index arrays for the neighbors coordinates
24 REAL zmask(9)
25 C
26 C We search over the eight closest neighbors
27 C
28 C j+1 7 8 9
29 C j 4 5 6 Current point 5 --> (i,j)
30 C j-1 1 2 3
31 C i-1 i i+1
32 c
33 c
34 ✗ IF (norsud) THEN
35 ✗ DO j = 1, kylat
36 ✗ DO i = 1, kxlon
37 ✗ pwork(i,j) = pfild(i,kylat-j+1)
38 ENDDO
39 ENDDO
40 ✗ DO j = 1, kylat
41 ✗ DO i = 1, kxlon
42 ✗ pfild(i,j) = pwork(i,j)
43 ENDDO
44 ENDDO
45 ENDIF
46 c
47 incre = 0
48 c
49 ✗ DO j = 1, kylat
50 ✗ DO i = 1, kxlon
51 ✗ pwork(i,j) = pfild(i,j)
52 ENDDO
53 ENDDO
54 c
55 C* To avoid problems in floating point tests
56 ✗ zwmsk = pmask - 1.0
57 c
58 200 CONTINUE
59 incre = incre + 1
60 ✗ DO 99999 j = 1, kylat
61 ✗ DO 99999 i = 1, kxlon
62 ✗ IF (pfild(i,j).GT. zwmsk) THEN
63 ✗ pwork(i,j) = pfild(i,j)
64 inbor = 0
65 ideb = 1
66 ifin = 9
67 C
68 C* Fill up ix array
69 ✗ ix(1) = MAX (1,i-1)
70 ✗ ix(2) = i
71 ✗ ix(3) = MIN (kxlon,i+1)
72 ✗ ix(4) = MAX (1,i-1)
73 ✗ ix(5) = i
74 ✗ ix(6) = MIN (kxlon,i+1)
75 ✗ ix(7) = MAX (1,i-1)
76 ✗ ix(8) = i
77 ✗ ix(9) = MIN (kxlon,i+1)
78 C
79 C* Fill up iy array
80 ✗ jy(1) = MAX (1,j-1)
81 ✗ jy(2) = MAX (1,j-1)
82 ✗ jy(3) = MAX (1,j-1)
83 ✗ jy(4) = j
84 ✗ jy(5) = j
85 ✗ jy(6) = j
86 ✗ jy(7) = MIN (kylat,j+1)
87 ✗ jy(8) = MIN (kylat,j+1)
88 ✗ jy(9) = MIN (kylat,j+1)
89 C
90 C* Correct latitude bounds if southernmost or northernmost points
91 ✗ IF (j .EQ. 1) ideb = 4
92 ✗ IF (j .EQ. kylat) ifin = 6
93 C
94 C* Account for periodicity in longitude
95 C
96 ✗ IF (ldper) THEN
97 ✗ IF (i .EQ. kxlon) THEN
98 ✗ ix(3) = 1
99 ✗ ix(6) = 1
100 ✗ ix(9) = 1
101 ✗ ELSE IF (i .EQ. 1) THEN
102 ✗ ix(1) = kxlon
103 ✗ ix(4) = kxlon
104 ✗ ix(7) = kxlon
105 ENDIF
106 ELSE
107 ✗ IF (i .EQ. 1) THEN
108 ✗ ix(1) = i
109 ✗ ix(2) = i + 1
110 ✗ ix(3) = i
111 ✗ ix(4) = i + 1
112 ix(5) = i
113 ✗ ix(6) = i + 1
114 ENDIF
115 ✗ IF (i .EQ. kxlon) THEN
116 ✗ ix(1) = i -1
117 ✗ ix(2) = i
118 ✗ ix(3) = i - 1
119 ✗ ix(4) = i
120 ✗ ix(5) = i - 1
121 ✗ ix(6) = i
122 ENDIF
123 C
124 ✗ IF (i .EQ. 1 .OR. i .EQ. kxlon) THEN
125 jy(1) = MAX (1,j-1)
126 jy(2) = MAX (1,j-1)
127 ✗ jy(3) = j
128 jy(4) = j
129 ✗ jy(5) = MIN (kylat,j+1)
130 ✗ jy(6) = MIN (kylat,j+1)
131 C
132 ideb = 1
133 ifin = 6
134 ✗ IF (j .EQ. 1) ideb = 3
135 ✗ IF (j .EQ. kylat) ifin = 4
136 ENDIF
137 ENDIF ! end for ldper test
138 C
139 C* Find unmasked neighbors
140 C
141 ✗ DO 230 k = ideb, ifin
142 ✗ zmask(k) = 0.
143 ✗ ilon = ix(k)
144 ✗ jlat = jy(k)
145 ✗ IF (pfild(ilon,jlat) .LT. zwmsk) THEN
146 ✗ zmask(k) = 1.
147 ✗ inbor = inbor + 1
148 ENDIF
149 ✗ 230 CONTINUE
150 C
151 C* Not enough points around point P are unmasked; interpolation on P
152 C will be done in a future call to extrap.
153 C
154 ✗ IF (inbor .GE. knbor) THEN
155 ✗ pwork(i,j) = 0.
156 ✗ DO k = ideb, ifin
157 ✗ ilon = ix(k)
158 ✗ jlat = jy(k)
159 pwork(i,j) = pwork(i,j)
160 ✗ $ + pfild(ilon,jlat) * zmask(k)/ REAL(inbor)
161 ENDDO
162 ENDIF
163 C
164 ENDIF
165 ✗ 99999 CONTINUE
166 C
167 C* 3. Writing back unmasked field in pfild
168 C ------------------------------------
169 C
170 C* pfild then contains:
171 C - Values which were not masked
172 C - Interpolated values from the inbor neighbors
173 C - Values which are not yet interpolated
174 C
175 idoit = 0
176 ✗ DO j = 1, kylat
177 ✗ DO i = 1, kxlon
178 ✗ IF (pwork(i,j) .GT. zwmsk) idoit = idoit + 1
179 ✗ pfild(i,j) = pwork(i,j)
180 ENDDO
181 ENDDO
182 c
183 ✗ IF (idoit .ne. 0) GOTO 200
184 ccc PRINT*, "Number of extrapolation steps incre =", incre
185 c
186 ✗ IF (norsud) THEN
187 ✗ DO j = 1, kylat
188 ✗ DO i = 1, kxlon
189 ✗ pwork(i,j) = pfild(i,kylat-j+1)
190 ENDDO
191 ENDDO
192 ✗ DO j = 1, kylat
193 ✗ DO i = 1, kxlon
194 ✗ pfild(i,j) = pwork(i,j)
195 ENDDO
196 ENDDO
197 ENDIF
198 c
199 ✗ RETURN
200 END
201