| 1 | MODULE tools_brice |
|---|
| 2 | !----------------------------------------------------------- |
|---|
| 3 | ! |
|---|
| 4 | ! to make it we use a 4th order polynomial interpolation |
|---|
| 5 | ! |
|---|
| 6 | ! Created by Brice Lemaire on 12/2009. |
|---|
| 7 | ! |
|---|
| 8 | !----------------------------------------------------------- |
|---|
| 9 | USE agrif_types |
|---|
| 10 | ! |
|---|
| 11 | IMPLICIT NONE |
|---|
| 12 | PUBLIC |
|---|
| 13 | ! |
|---|
| 14 | INTEGER :: nxGmix, nyGmix |
|---|
| 15 | INTEGER :: nxG1, nyG1, nxG2, nyG2, nxG3, nyG3, nxG4, nyG4 |
|---|
| 16 | INTEGER :: nxG1mix, nyG1mix |
|---|
| 17 | INTEGER :: nxG2mix, nyG2mix |
|---|
| 18 | INTEGER :: nxG3mix, nyG3mix |
|---|
| 19 | INTEGER :: nxG4mix, nyG4mix |
|---|
| 20 | INTEGER :: nx_fine, ny_fine, nx_coarse, ny_coarse |
|---|
| 21 | INTEGER :: i, j, i_min, j_min |
|---|
| 22 | INTEGER :: k, m |
|---|
| 23 | ! |
|---|
| 24 | PUBLIC mixed_grid |
|---|
| 25 | PRIVATE mixed_G1, mixed_G2, mixed_G4 |
|---|
| 26 | ! |
|---|
| 27 | INTERFACE mixed_grid |
|---|
| 28 | MODULE PROCEDURE mixed_G1, mixed_G2, mixed_G4 |
|---|
| 29 | END INTERFACE |
|---|
| 30 | ! |
|---|
| 31 | CONTAINS |
|---|
| 32 | ! |
|---|
| 33 | !******************************************************** |
|---|
| 34 | ! SUBROUTINE mixed grid * |
|---|
| 35 | ! * |
|---|
| 36 | ! mix from four grids (U,V,F,T) to one grid * |
|---|
| 37 | ! * |
|---|
| 38 | ! CALLED from create_coordinates.f90 * |
|---|
| 39 | !******************************************************** |
|---|
| 40 | ! |
|---|
| 41 | SUBROUTINE mixed_G1(G1,Gmix) |
|---|
| 42 | ! |
|---|
| 43 | TYPE(Coordinates), INTENT(IN) :: G1 |
|---|
| 44 | TYPE(mixed_coordinates), INTENT(INOUT) :: Gmix |
|---|
| 45 | ! |
|---|
| 46 | WRITE(*,*) '' |
|---|
| 47 | WRITE(*,*) '*** ROUTINE mixed_G1 ***' |
|---|
| 48 | WRITE(*,*) '' |
|---|
| 49 | ! |
|---|
| 50 | nxG1 = (imax+1) - (imin-1) + 1 !(+1) rajout de 2 bandes fantmes |
|---|
| 51 | nyG1 = (jmax+1) - (jmin-1) + 1 |
|---|
| 52 | ! |
|---|
| 53 | WRITE(*,*) '' |
|---|
| 54 | WRITE(*,*) '*** CHECKING SIZE OF INPUT GRID***' |
|---|
| 55 | WRITE(*,*) nxG1, 'x', nyG1 |
|---|
| 56 | WRITE(*,*) '' |
|---|
| 57 | ! |
|---|
| 58 | nx_coarse = nxG1 |
|---|
| 59 | ny_coarse = nyG1 |
|---|
| 60 | ! |
|---|
| 61 | !!!Calculate size of mixed grid (nx x ny) |
|---|
| 62 | nxGmix = (nx_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 63 | nxGmix = nxGmix + (rho-1)*(nxGmix-1) !nbre de points interpoler |
|---|
| 64 | ! |
|---|
| 65 | nyGmix = (ny_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant y |
|---|
| 66 | nyGmix = nyGmix + (rho-1)*(nyGmix-1) !nbre de points interpoler |
|---|
| 67 | ! |
|---|
| 68 | WRITE(*,*) '' |
|---|
| 69 | WRITE(*,*) '*** SIZE OF MIXED GRID ***' |
|---|
| 70 | WRITE(*,*) nxGmix, ' x ', nyGmix |
|---|
| 71 | WRITE(*,*) '' |
|---|
| 72 | ! |
|---|
| 73 | nx_fine = (nx_coarse-2)*rho + 1 |
|---|
| 74 | ny_fine = (ny_coarse-2)*rho + 1 |
|---|
| 75 | ! |
|---|
| 76 | WRITE(*,*) '' |
|---|
| 77 | WRITE(*,*) '*** SIZE OF FINE GRID ***' |
|---|
| 78 | WRITE(*,*) nx_fine, ' x ', ny_fine |
|---|
| 79 | WRITE(*,*) '' |
|---|
| 80 | ! |
|---|
| 81 | !!!Allocate mixed grid |
|---|
| 82 | CALL mixed_grid_allocate(Gmix,nxGmix,nyGmix) !from agrif_types |
|---|
| 83 | ! |
|---|
| 84 | !!!Calculate part of each grid to make Gmix |
|---|
| 85 | nxG1mix = nxGmix |
|---|
| 86 | nyG1mix = nyGmix |
|---|
| 87 | ! |
|---|
| 88 | !***On rcupre les pts depuis G1 |
|---|
| 89 | j_min = jmin-1 |
|---|
| 90 | DO j=1,nyG1mix,(2*rho) |
|---|
| 91 | i_min = imin-1 |
|---|
| 92 | DO i=1,nxG1mix,(2*rho) |
|---|
| 93 | Gmix%nav_lon(i,j) = G1%nav_lon(i_min,j_min) |
|---|
| 94 | Gmix%nav_lat(i+rho,j) = G1%nav_lat(i_min,j_min) |
|---|
| 95 | ! |
|---|
| 96 | Gmix%glam(i,j) = G1%glamt(i_min,j_min) |
|---|
| 97 | Gmix%glam(i+rho,j) = G1%glamu(i_min,j_min) |
|---|
| 98 | Gmix%glam(i,j+rho) = G1%glamv(i_min,j_min) |
|---|
| 99 | Gmix%glam(i+rho,j+rho) = G1%glamf(i_min,j_min) |
|---|
| 100 | ! |
|---|
| 101 | Gmix%gphi(i,j) = G1%gphit(i_min,j_min) |
|---|
| 102 | Gmix%gphi(i+rho,j) = G1%gphiu(i_min,j_min) |
|---|
| 103 | Gmix%gphi(i,j+rho) = G1%gphiv(i_min,j_min) |
|---|
| 104 | Gmix%gphi(i+rho,j+rho) = G1%gphif(i_min,j_min) |
|---|
| 105 | ! |
|---|
| 106 | Gmix%e1(i,j) = G1%e1t(i_min,j_min) |
|---|
| 107 | Gmix%e1(i+rho,j) = G1%e1u(i_min,j_min) |
|---|
| 108 | Gmix%e1(i,j+rho) = G1%e1v(i_min,j_min) |
|---|
| 109 | Gmix%e1(i+rho,j+rho) = G1%e1f(i_min,j_min) |
|---|
| 110 | ! |
|---|
| 111 | Gmix%e2(i,j) = G1%e2t(i_min,j_min) |
|---|
| 112 | Gmix%e2(i+rho,j) = G1%e2u(i_min,j_min) |
|---|
| 113 | Gmix%e2(i,j+rho) = G1%e2v(i_min,j_min) |
|---|
| 114 | Gmix%e2(i+rho,j+rho) = G1%e2f(i_min,j_min) |
|---|
| 115 | ! |
|---|
| 116 | i_min = i_min+1 |
|---|
| 117 | ENDDO |
|---|
| 118 | j_min = j_min+1 |
|---|
| 119 | ENDDO |
|---|
| 120 | ! |
|---|
| 121 | !print*, 'Gmix%nav_lat= ' |
|---|
| 122 | !DO j=1,nyG1mix |
|---|
| 123 | !print*, Gmix%nav_lat(:,j) |
|---|
| 124 | !END DO |
|---|
| 125 | ! |
|---|
| 126 | print*, 'G1%glamt= ' |
|---|
| 127 | DO j=jmin-1,jmax+1 |
|---|
| 128 | print*, G1%glamt(imin-1:imax+1,j) |
|---|
| 129 | ENDDO |
|---|
| 130 | print*,'' |
|---|
| 131 | print*, 'G1%glamu= ' |
|---|
| 132 | DO j=jmin-1,jmax+1 |
|---|
| 133 | print*, G1%glamu(imin-1:imax+1,j) |
|---|
| 134 | ENDDO |
|---|
| 135 | print*,'' |
|---|
| 136 | print*, 'Gmix%glam= ' |
|---|
| 137 | DO j=1,nyGmix |
|---|
| 138 | print*, Gmix%glam(:,j) |
|---|
| 139 | ENDDO |
|---|
| 140 | ! |
|---|
| 141 | END SUBROUTINE |
|---|
| 142 | ! |
|---|
| 143 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 144 | ! |
|---|
| 145 | SUBROUTINE mixed_G2(G1,G2,Gmix) |
|---|
| 146 | ! |
|---|
| 147 | TYPE(Coordinates), INTENT(IN) :: G1,G2 |
|---|
| 148 | TYPE(mixed_coordinates), INTENT(INOUT) :: Gmix |
|---|
| 149 | ! |
|---|
| 150 | WRITE(*,*) '' |
|---|
| 151 | WRITE(*,*) '*** ROUTINE mixed_G2 ***' |
|---|
| 152 | WRITE(*,*) '' |
|---|
| 153 | ! |
|---|
| 154 | ! |
|---|
| 155 | nxG1 = SIZE(G1%glamt,1) - (imin-1) + 1 !(+1) rajout d'une bande fantme |
|---|
| 156 | nyG1 = (jmax+1) - (jmin-1) + 1 |
|---|
| 157 | print*, nxG1, nyG1 |
|---|
| 158 | ! |
|---|
| 159 | nxG2 = (imax+1) - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 160 | nyG2 = nyG1 |
|---|
| 161 | print*, nxG2, nyG2 |
|---|
| 162 | ! |
|---|
| 163 | nx_coarse = nxG1+nxG2 |
|---|
| 164 | ny_coarse = nyG1 |
|---|
| 165 | ! |
|---|
| 166 | !!!Calculate size of mixed grid (nx x ny) |
|---|
| 167 | nxGmix = (nx_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 168 | nxGmix = nxGmix + (rho-1)*(nxGmix-1) !nbre de points interpoler |
|---|
| 169 | ! |
|---|
| 170 | nyGmix = (ny_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant y |
|---|
| 171 | nyGmix = nyGmix + (rho-1)*(nyGmix-1) !nbre de points interpoler |
|---|
| 172 | ! |
|---|
| 173 | WRITE(*,*) '*** SIZE OF MIXED GRID ***' |
|---|
| 174 | WRITE(*,*) nxGmix, ' x ', nyGmix |
|---|
| 175 | WRITE(*,*) '' |
|---|
| 176 | ! |
|---|
| 177 | !nx_fine = (nxG1-1 + nxG2-1)*rho + 1 !(-1) on supprime les 2 bandes fantmes |
|---|
| 178 | !ny_fine = (nyG1-1)*rho + 1 |
|---|
| 179 | |
|---|
| 180 | nx_fine = (nx_coarse-2)*rho + 1 |
|---|
| 181 | ny_fine = (ny_coarse-2)*rho + 1 |
|---|
| 182 | ! |
|---|
| 183 | WRITE(*,*) '*** SIZE OF FINE GRID ***' |
|---|
| 184 | WRITE(*,*) nx_fine, ' x ', ny_fine |
|---|
| 185 | WRITE(*,*) '' |
|---|
| 186 | ! |
|---|
| 187 | !!!Allocate mixed grid |
|---|
| 188 | CALL mixed_grid_allocate(Gmix,nxGmix,nyGmix) !from agrif_types |
|---|
| 189 | ! |
|---|
| 190 | !!!Calculate part of each grid to make Gmix |
|---|
| 191 | nxG1mix = nxG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 192 | nxG1mix = nxG1mix + (rho-1)*(nxG1mix-1) !nbre de points interpoler |
|---|
| 193 | ! |
|---|
| 194 | nyG1mix = nyG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 195 | nyG1mix = nyG1mix + (rho-1)*(nyG1mix-1) !nbre de points interpoler |
|---|
| 196 | print*,'nxG1mix= ', nxG1mix, 'nyG1mix= ', nyG1mix |
|---|
| 197 | ! |
|---|
| 198 | nxG2mix = nxG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 199 | nxG2mix = nxG2mix + (rho-1)*(nxG2mix-1) + 1 !nbre de points interpoler |
|---|
| 200 | ! |
|---|
| 201 | nyG2mix = nyG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 202 | nyG2mix = nyG2mix + (rho-1)*(nyG2mix-1) !nbre de points interpoler |
|---|
| 203 | print*,'nxG2mix= ', nxG2mix, 'nyG2mix= ', nyG2mix |
|---|
| 204 | ! |
|---|
| 205 | IF((nxG1mix+nxG2mix).NE.nxGmix) THEN |
|---|
| 206 | WRITE(*,*) '' |
|---|
| 207 | WRITE(*,*) '*** ERROR ***' |
|---|
| 208 | WRITE(*,*) 'nxG1mix + nxG2mix /= nxGmix' |
|---|
| 209 | WRITE(*,*) nxG1mix + nxG2mix, ' /= ', nxGmix |
|---|
| 210 | WRITE(*,*) '' |
|---|
| 211 | ENDIF |
|---|
| 212 | ! |
|---|
| 213 | !*** On rcupre les pts depuis G1 |
|---|
| 214 | j_min = jmin-1 |
|---|
| 215 | DO j=1,nyG1mix,(2*rho) |
|---|
| 216 | i_min = imin-1 |
|---|
| 217 | DO i=1,nxG1mix,(2*rho) |
|---|
| 218 | Gmix%nav_lon(i,j) = G1%nav_lon(i_min,j_min) |
|---|
| 219 | Gmix%nav_lat(i+rho,j) = G1%nav_lat(i_min,j_min) |
|---|
| 220 | ! |
|---|
| 221 | Gmix%glam(i,j) = G1%glamt(i_min,j_min) |
|---|
| 222 | Gmix%glam(i+rho,j) = G1%glamu(i_min,j_min) |
|---|
| 223 | Gmix%glam(i,j+rho) = G1%glamv(i_min,j_min) |
|---|
| 224 | Gmix%glam(i+rho,j+rho) = G1%glamf(i_min,j_min) |
|---|
| 225 | ! |
|---|
| 226 | Gmix%gphi(i,j) = G1%gphit(i_min,j_min) |
|---|
| 227 | Gmix%gphi(i+rho,j) = G1%gphiu(i_min,j_min) |
|---|
| 228 | Gmix%gphi(i,j+rho) = G1%gphiv(i_min,j_min) |
|---|
| 229 | Gmix%gphi(i+rho,j+rho) = G1%gphif(i_min,j_min) |
|---|
| 230 | ! |
|---|
| 231 | Gmix%e1(i,j) = G1%e1t(i_min,j_min) |
|---|
| 232 | Gmix%e1(i+rho,j) = G1%e1u(i_min,j_min) |
|---|
| 233 | Gmix%e1(i,j+rho) = G1%e1v(i_min,j_min) |
|---|
| 234 | Gmix%e1(i+rho,j+rho) = G1%e1f(i_min,j_min) |
|---|
| 235 | ! |
|---|
| 236 | Gmix%e2(i,j) = G1%e2t(i_min,j_min) |
|---|
| 237 | Gmix%e2(i+rho,j) = G1%e2u(i_min,j_min) |
|---|
| 238 | Gmix%e2(i,j+rho) = G1%e2v(i_min,j_min) |
|---|
| 239 | Gmix%e2(i+rho,j+rho) = G1%e2f(i_min,j_min) |
|---|
| 240 | ! |
|---|
| 241 | i_min = i_min+1 |
|---|
| 242 | ENDDO |
|---|
| 243 | j_min = j_min+1 |
|---|
| 244 | ENDDO |
|---|
| 245 | ! |
|---|
| 246 | !***On rcupre les pts depuis G2 |
|---|
| 247 | j_min = jmin - 1 |
|---|
| 248 | DO j=1,nyG2mix,(2*rho) |
|---|
| 249 | i_min = 3 |
|---|
| 250 | DO k=i,nxGmix,(2*rho) |
|---|
| 251 | print*, k |
|---|
| 252 | Gmix%nav_lon(k,j) = G2%nav_lon(i_min,j_min) |
|---|
| 253 | Gmix%nav_lat(k+rho,j) = G2%nav_lat(i_min,j_min) |
|---|
| 254 | ! |
|---|
| 255 | Gmix%glam(k,j) = G2%glamt(i_min,j_min) |
|---|
| 256 | Gmix%glam(k+rho,j) = G2%glamu(i_min,j_min) |
|---|
| 257 | Gmix%glam(k,j+rho) = G2%glamv(i_min,j_min) |
|---|
| 258 | Gmix%glam(k+rho,j+rho) = G2%glamf(i_min,j_min) |
|---|
| 259 | ! |
|---|
| 260 | Gmix%gphi(k,j) = G2%gphit(i_min,j_min) |
|---|
| 261 | Gmix%gphi(k+rho,j) = G2%gphiu(i_min,j_min) |
|---|
| 262 | Gmix%gphi(k,j+rho) = G2%gphiv(i_min,j_min) |
|---|
| 263 | Gmix%gphi(k+rho,j+rho) = G2%gphif(i_min,j_min) |
|---|
| 264 | ! |
|---|
| 265 | Gmix%e1(k,j) = G2%e1t(i_min,j_min) |
|---|
| 266 | Gmix%e1(k+rho,j) = G2%e1u(i_min,j_min) |
|---|
| 267 | Gmix%e1(k,j+rho) = G2%e1v(i_min,j_min) |
|---|
| 268 | Gmix%e1(k+rho,j+rho) = G2%e1f(i_min,j_min) |
|---|
| 269 | ! |
|---|
| 270 | Gmix%e2(k,j) = G2%e2t(i_min,j_min) |
|---|
| 271 | Gmix%e2(k+rho,j) = G2%e2u(i_min,j_min) |
|---|
| 272 | Gmix%e2(k,j+rho) = G2%e2v(i_min,j_min) |
|---|
| 273 | Gmix%e2(k+rho,j+rho) = G2%e2f(i_min,j_min) |
|---|
| 274 | ! |
|---|
| 275 | i_min = i_min+1 |
|---|
| 276 | ENDDO |
|---|
| 277 | j_min = j_min+1 |
|---|
| 278 | ENDDO |
|---|
| 279 | ! |
|---|
| 280 | print*, 'G1%glamt= ' |
|---|
| 281 | DO j=jmin-1,jmax+1 |
|---|
| 282 | print*, G1%glamt(imin-1:SIZE(G1%glamt,1),j) |
|---|
| 283 | ENDDO |
|---|
| 284 | print*,'' |
|---|
| 285 | print*, 'G1%glamu= ' |
|---|
| 286 | DO j=jmin-1,jmax+1 |
|---|
| 287 | print*, G1%glamu(imin-1:SIZE(G1%glamu,1),j) |
|---|
| 288 | ENDDO |
|---|
| 289 | print*,'' |
|---|
| 290 | print*, 'Gmix%glam= ' |
|---|
| 291 | DO j=1,nyGmix |
|---|
| 292 | print*, Gmix%glam(:,j) |
|---|
| 293 | ENDDO |
|---|
| 294 | |
|---|
| 295 | END SUBROUTINE |
|---|
| 296 | ! |
|---|
| 297 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 298 | ! |
|---|
| 299 | SUBROUTINE mixed_G3(G1,G3,Gmix) |
|---|
| 300 | ! |
|---|
| 301 | TYPE(Coordinates), INTENT(IN) :: G1,G2,G3 |
|---|
| 302 | TYPE(mixed_coordinates), INTENT(INOUT) :: Gmix |
|---|
| 303 | ! |
|---|
| 304 | WRITE(*,*) '' |
|---|
| 305 | WRITE(*,*) '*** ROUTINE mixed_G3 ***' |
|---|
| 306 | WRITE(*,*) '' |
|---|
| 307 | ! |
|---|
| 308 | ! |
|---|
| 309 | nxG1 = (imax+1) - (imin-1) + 1 !(+1) rajout de 2 bandes fantmes |
|---|
| 310 | nyG1 = SIZE(G1%glamt,2) - (jmin-1) + 1 |
|---|
| 311 | print*, nxG1, nyG1 |
|---|
| 312 | ! |
|---|
| 313 | nxG3 = nxG1 |
|---|
| 314 | nyG3 = SIZE(G3%glamt,2) - (jmax-1) + 1 - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 315 | print*, nxG3, nyG3 |
|---|
| 316 | ! |
|---|
| 317 | nx_coarse = nxG1 |
|---|
| 318 | ny_coarse = nyG1 + nyG3 |
|---|
| 319 | ! |
|---|
| 320 | !!!Calculate size of mixed grid (nx x ny) |
|---|
| 321 | nxGmix = (nx_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 322 | nxGmix = nxGmix + (rho-1)*(nxGmix-1) !nbre de points interpoler |
|---|
| 323 | ! |
|---|
| 324 | nyGmix = (ny_coarse) * 2 !nbre de pts connus (T,U,V,F) suivant y |
|---|
| 325 | nyGmix = nyGmix + (rho-1)*(nyGmix-1) !nbre de points interpoler |
|---|
| 326 | ! |
|---|
| 327 | WRITE(*,*) '*** SIZE OF MIXED GRID ***' |
|---|
| 328 | WRITE(*,*) nxGmix, ' x ', nyGmix |
|---|
| 329 | WRITE(*,*) '' |
|---|
| 330 | ! |
|---|
| 331 | !nx_fine = (nxGmix/2) - 1 |
|---|
| 332 | !ny_fine = (nyGmix/2) - 1 |
|---|
| 333 | nx_fine = (nx_coarse-2)*rho + 1 |
|---|
| 334 | ny_fine = (ny_coarse-2)*rho + 1 |
|---|
| 335 | |
|---|
| 336 | ! |
|---|
| 337 | WRITE(*,*) '*** SIZE OF FINE GRID ***' |
|---|
| 338 | WRITE(*,*) nx_fine, ' x ', ny_fine |
|---|
| 339 | WRITE(*,*) '' |
|---|
| 340 | ! |
|---|
| 341 | !!!Allocate mixed grid |
|---|
| 342 | CALL mixed_grid_allocate(Gmix,nxGmix,nyGmix) !from agrif_types |
|---|
| 343 | ! |
|---|
| 344 | !!!Calculate part of each grid to make Gmix |
|---|
| 345 | nxG1mix = nxG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 346 | nxG1mix = nxG1mix + (rho-1)*(nxG1mix-1) !nbre de points interpoler |
|---|
| 347 | ! |
|---|
| 348 | nyG1mix = nyG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 349 | nyG1mix = nyG1mix + (rho-1)*(nyG1mix-1) !nbre de points interpoler |
|---|
| 350 | print*,'nxG1mix= ', nxG1mix, 'nyG1mix= ', nyG1mix |
|---|
| 351 | ! |
|---|
| 352 | nxG2mix = nxG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 353 | nxG2mix = nxG2mix + (rho-1)*(nxG2mix-1) !nbre de points interpoler |
|---|
| 354 | ! |
|---|
| 355 | nyG2mix = nyG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 356 | nyG2mix = nyG2mix + (rho-1)*(nyG2mix-1) !nbre de points interpoler |
|---|
| 357 | print*,'nxG2mix= ', nxG2mix, 'nyG2mix= ', nyG2mix |
|---|
| 358 | ! |
|---|
| 359 | nxG3mix = nxG3 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 360 | nxG3mix = nxG3mix + (rho-1)*(nxG3mix-1) !nbre de points interpoler |
|---|
| 361 | ! |
|---|
| 362 | nyG3mix = nyG3 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 363 | nyG3mix = nyG3mix + (rho-1)*(nyG3mix-1) !nbre de points interpoler |
|---|
| 364 | print*,'nxG3mix= ', nxG3mix, 'nyG3mix= ', nyG3mix |
|---|
| 365 | ! |
|---|
| 366 | nxG4mix = nxG4 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 367 | nxG4mix = nxG4mix + (rho-1)*(nxG4mix-1) !nbre de points interpoler |
|---|
| 368 | ! |
|---|
| 369 | nyG4mix = nyG4 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 370 | nyG4mix = nyG4mix + (rho-1)*(nyG4mix-1) !nbre de points interpoler |
|---|
| 371 | print*,'nxG4mix= ', nxG4mix, 'nyG4mix= ', nyG4mix |
|---|
| 372 | ! |
|---|
| 373 | |
|---|
| 374 | !***On rcupre les pts depuis G1 |
|---|
| 375 | j_min = jmin-1 |
|---|
| 376 | DO j=1,nyG1mix,(2*rho) |
|---|
| 377 | i_min = imin-1 |
|---|
| 378 | DO i=1,nxG1mix,(2*rho) |
|---|
| 379 | Gmix%nav_lon(i,j) = G1%nav_lon(i_min,j_min) |
|---|
| 380 | Gmix%nav_lat(i+rho,j) = G1%nav_lat(i_min,j_min) |
|---|
| 381 | ! |
|---|
| 382 | Gmix%glam(i,j) = G1%glamt(i_min,j_min) |
|---|
| 383 | Gmix%glam(i+rho,j) = G1%glamu(i_min,j_min) |
|---|
| 384 | Gmix%glam(i,j+rho) = G1%glamv(i_min,j_min) |
|---|
| 385 | Gmix%glam(i+rho,j+rho) = G1%glamf(i_min,j_min) |
|---|
| 386 | ! |
|---|
| 387 | Gmix%gphi(i,j) = G1%gphit(i_min,j_min) |
|---|
| 388 | Gmix%gphi(i+rho,j) = G1%gphiu(i_min,j_min) |
|---|
| 389 | Gmix%gphi(i,j+rho) = G1%gphiv(i_min,j_min) |
|---|
| 390 | Gmix%gphi(i+rho,j+rho) = G1%gphif(i_min,j_min) |
|---|
| 391 | ! |
|---|
| 392 | Gmix%e1(i,j) = G1%e1t(i_min,j_min) |
|---|
| 393 | Gmix%e1(i+rho,j) = G1%e1u(i_min,j_min) |
|---|
| 394 | Gmix%e1(i,j+rho) = G1%e1v(i_min,j_min) |
|---|
| 395 | Gmix%e1(i+rho,j+rho) = G1%e1f(i_min,j_min) |
|---|
| 396 | ! |
|---|
| 397 | Gmix%e2(i,j) = G1%e2t(i_min,j_min) |
|---|
| 398 | Gmix%e2(i+rho,j) = G1%e2u(i_min,j_min) |
|---|
| 399 | Gmix%e2(i,j+rho) = G1%e2v(i_min,j_min) |
|---|
| 400 | Gmix%e2(i+rho,j+rho) = G1%e2f(i_min,j_min) |
|---|
| 401 | ! |
|---|
| 402 | i_min = i_min+1 |
|---|
| 403 | ENDDO |
|---|
| 404 | j_min = j_min+1 |
|---|
| 405 | ENDDO |
|---|
| 406 | ! |
|---|
| 407 | !***On rcupre les pts depuis G2 |
|---|
| 408 | j_min = jmin - 1 |
|---|
| 409 | DO j=1,nyG2mix,(2*rho) |
|---|
| 410 | i_min = 3 |
|---|
| 411 | DO k=i,nxGmix,(2*rho) |
|---|
| 412 | Gmix%nav_lon(k,j) = G2%nav_lon(i_min,j_min) |
|---|
| 413 | Gmix%nav_lat(k+rho,j) = G2%nav_lat(i_min,j_min) |
|---|
| 414 | ! |
|---|
| 415 | Gmix%glam(k,j) = G2%glamt(i_min,j_min) |
|---|
| 416 | Gmix%glam(k+rho,j) = G2%glamu(i_min,j_min) |
|---|
| 417 | Gmix%glam(k,j+rho) = G2%glamv(i_min,j_min) |
|---|
| 418 | Gmix%glam(k+rho,j+rho) = G2%glamf(i_min,j_min) |
|---|
| 419 | ! |
|---|
| 420 | Gmix%gphi(k,j) = G2%gphit(i_min,j_min) |
|---|
| 421 | Gmix%gphi(k+rho,j) = G2%gphiu(i_min,j_min) |
|---|
| 422 | Gmix%gphi(k,j+rho) = G2%gphiv(i_min,j_min) |
|---|
| 423 | Gmix%gphi(k+rho,j+rho) = G2%gphif(i_min,j_min) |
|---|
| 424 | ! |
|---|
| 425 | Gmix%e1(k,j) = G2%e1t(i_min,j_min) |
|---|
| 426 | Gmix%e1(k+rho,j) = G2%e1u(i_min,j_min) |
|---|
| 427 | Gmix%e1(k,j+rho) = G2%e1v(i_min,j_min) |
|---|
| 428 | Gmix%e1(k+rho,j+rho) = G2%e1f(i_min,j_min) |
|---|
| 429 | ! |
|---|
| 430 | Gmix%e2(k,j) = G2%e2t(i_min,j_min) |
|---|
| 431 | Gmix%e2(k+rho,j) = G2%e2u(i_min,j_min) |
|---|
| 432 | Gmix%e2(k,j+rho) = G2%e2v(i_min,j_min) |
|---|
| 433 | Gmix%e2(k+rho,j+rho) = G2%e2f(i_min,j_min) |
|---|
| 434 | ! |
|---|
| 435 | i_min = i_min+1 |
|---|
| 436 | ENDDO |
|---|
| 437 | j_min = j_min+1 |
|---|
| 438 | ENDDO |
|---|
| 439 | ! |
|---|
| 440 | !**On rcupre les pts depuis G3 |
|---|
| 441 | j_min = SIZE(G3%glamt,2)-2 !on supprime les bandes de chevauchement |
|---|
| 442 | DO m=j,nyGmix,(2*rho) |
|---|
| 443 | i_min = imin + imax |
|---|
| 444 | DO i=1,nxG3mix,(2*rho) |
|---|
| 445 | Gmix%nav_lon(i,m) = G3%nav_lon(i_min,j_min) |
|---|
| 446 | Gmix%nav_lat(i+rho,m) = G3%nav_lat(i_min,j_min) |
|---|
| 447 | ! |
|---|
| 448 | Gmix%glam(i,m) = G3%glamt(i_min,j_min) |
|---|
| 449 | Gmix%glam(i+rho,m) = G3%glamu(i_min,j_min) |
|---|
| 450 | Gmix%glam(i,m+rho) = G3%glamv(i_min,j_min) |
|---|
| 451 | Gmix%glam(i+rho,m+rho) = G3%glamf(i_min,j_min) |
|---|
| 452 | ! |
|---|
| 453 | Gmix%gphi(i,m) = G3%gphit(i_min,j_min) |
|---|
| 454 | Gmix%gphi(i+rho,m) = G3%gphiu(i_min,j_min) |
|---|
| 455 | Gmix%gphi(i,m+rho) = G3%gphiv(i_min,j_min) |
|---|
| 456 | Gmix%gphi(i+rho,m+rho) = G3%gphif(i_min,j_min) |
|---|
| 457 | ! |
|---|
| 458 | Gmix%e1(i,m) = G3%e1t(i_min,j_min) |
|---|
| 459 | Gmix%e1(i+rho,m) = G3%e1u(i_min,j_min) |
|---|
| 460 | Gmix%e1(i,m+rho) = G3%e1v(i_min,j_min) |
|---|
| 461 | Gmix%e1(i+rho,m+rho) = G3%e1f(i_min,j_min) |
|---|
| 462 | ! |
|---|
| 463 | Gmix%e2(i,m) = G3%e2t(i_min,j_min) |
|---|
| 464 | Gmix%e2(i+rho,m) = G3%e2u(i_min,j_min) |
|---|
| 465 | Gmix%e2(i,m+rho) = G3%e2v(i_min,j_min) |
|---|
| 466 | Gmix%e2(i+rho,m+rho) = G3%e2f(i_min,j_min) |
|---|
| 467 | ! |
|---|
| 468 | i_min = i_min - 1 !on se dplace le long de (-i) |
|---|
| 469 | ENDDO |
|---|
| 470 | j_min = j_min - 1 !on se dplace le long de (-j) |
|---|
| 471 | ENDDO |
|---|
| 472 | ! |
|---|
| 473 | !**On rcupre les pts depuis G4 |
|---|
| 474 | j_min = SIZE(G4%glamt,2)-2 !on supprime les bandes de chevauchement |
|---|
| 475 | DO m=j,nyGmix,(2*rho) |
|---|
| 476 | i_min = SIZE(G4%glamt,1)-2 |
|---|
| 477 | DO k=i,nxGmix,(2*rho) |
|---|
| 478 | Gmix%nav_lon(k,m) = G4%nav_lon(i_min,j_min) |
|---|
| 479 | Gmix%nav_lat(k+rho,m) = G4%nav_lat(i_min,j_min) |
|---|
| 480 | ! |
|---|
| 481 | Gmix%glam(k,m) = G4%glamt(i_min,j_min) |
|---|
| 482 | Gmix%glam(k+rho,m) = G4%glamu(i_min,j_min) |
|---|
| 483 | Gmix%glam(k,m+rho) = G4%glamv(i_min,j_min) |
|---|
| 484 | Gmix%glam(k+rho,m+rho) = G4%glamf(i_min,j_min) |
|---|
| 485 | ! |
|---|
| 486 | Gmix%gphi(k,m) = G4%gphit(i_min,j_min) |
|---|
| 487 | Gmix%gphi(k+rho,m) = G4%gphiu(i_min,j_min) |
|---|
| 488 | Gmix%gphi(k,m+rho) = G4%gphiv(i_min,j_min) |
|---|
| 489 | Gmix%gphi(k+rho,m+rho) = G4%gphif(i_min,j_min) |
|---|
| 490 | ! |
|---|
| 491 | Gmix%e1(k,m) = G4%e1t(i_min,j_min) |
|---|
| 492 | Gmix%e1(k+rho,m) = G4%e1u(i_min,j_min) |
|---|
| 493 | Gmix%e1(k,m+rho) = G4%e1v(i_min,j_min) |
|---|
| 494 | Gmix%e1(k+rho,m+rho) = G4%e1f(i_min,j_min) |
|---|
| 495 | ! |
|---|
| 496 | Gmix%e2(k,m) = G4%e2t(i_min,j_min) |
|---|
| 497 | Gmix%e2(k+rho,m) = G4%e2u(i_min,j_min) |
|---|
| 498 | Gmix%e2(k,m+rho) = G4%e2v(i_min,j_min) |
|---|
| 499 | Gmix%e2(k+rho,m+rho) = G4%e2f(i_min,j_min) |
|---|
| 500 | ! |
|---|
| 501 | i_min = i_min - 1 !on se dplace le long de (-i) |
|---|
| 502 | ENDDO |
|---|
| 503 | j_min = j_min - 1 !on se dplace le long de (-j) |
|---|
| 504 | ENDDO |
|---|
| 505 | ! |
|---|
| 506 | print*, 'G1%glamt= ' |
|---|
| 507 | DO j=jmin-1,SIZE(G1%glamt,2) |
|---|
| 508 | print*, G1%glamt(imin-1:SIZE(G1%glamt,1),j) |
|---|
| 509 | ENDDO |
|---|
| 510 | print*,'' |
|---|
| 511 | print*, 'G1%glamu= ' |
|---|
| 512 | DO j=jmin-1,SIZE(G1%glamu,2) |
|---|
| 513 | print*, G1%glamu(imin-1:SIZE(G1%glamu,1),j) |
|---|
| 514 | ENDDO |
|---|
| 515 | print*,'' |
|---|
| 516 | print*, 'Gmix%glam= ' |
|---|
| 517 | DO j=1,nyGmix |
|---|
| 518 | print*, Gmix%glam(:,j) |
|---|
| 519 | ENDDO |
|---|
| 520 | |
|---|
| 521 | END SUBROUTINE |
|---|
| 522 | ! |
|---|
| 523 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 524 | ! |
|---|
| 525 | SUBROUTINE mixed_G4(G1,G2,G3,G4,Gmix) |
|---|
| 526 | ! |
|---|
| 527 | TYPE(Coordinates), INTENT(IN) :: G1,G2,G3,G4 |
|---|
| 528 | TYPE(mixed_coordinates), INTENT(INOUT) :: Gmix |
|---|
| 529 | ! |
|---|
| 530 | WRITE(*,*) '' |
|---|
| 531 | WRITE(*,*) '*** ROUTINE mixed_G4 ***' |
|---|
| 532 | WRITE(*,*) '' |
|---|
| 533 | ! |
|---|
| 534 | ! |
|---|
| 535 | nxG1 = SIZE(G1%glamt,1) - (imin-1) + 1 !(+1) rajout d'une bande fantme |
|---|
| 536 | nyG1 = SIZE(G1%glamt,2) - (jmin-1) + 1 |
|---|
| 537 | print*, nxG1, nyG1 |
|---|
| 538 | ! |
|---|
| 539 | nxG2 = imax + 1 - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 540 | nyG2 = SIZE(G2%glamt,2) - (jmin-1) + 1 |
|---|
| 541 | print*, nxG2, nyG2 |
|---|
| 542 | ! |
|---|
| 543 | nxG3 = SIZE(G3%glamt,1) - (imin-1) + 1 |
|---|
| 544 | nyG3 = SIZE(G3%glamt,2) - (jmax-1) + 1 - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 545 | print*, nxG3, nyG3 |
|---|
| 546 | ! |
|---|
| 547 | nxG4 = imax + 1 - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 548 | nyG4 = SIZE(G4%glamt,2) - (jmax-1) + 1 - 2 !(-2) on supprime les bandes de chevauchement |
|---|
| 549 | print*, nxG4, nyG4 |
|---|
| 550 | ! |
|---|
| 551 | WRITE(*,*) '' |
|---|
| 552 | WRITE(*,*) '*** CHECKING SIZE OF THE MIXED GRID***' |
|---|
| 553 | WRITE(*,*) ' nxG1 + nxG2 = nxG3 + nxG4 = nx_coarse' |
|---|
| 554 | WRITE(*,*) nxG1 + nxG2, ' = ', nxG3 + nxG4 |
|---|
| 555 | WRITE(*,*) '' |
|---|
| 556 | WRITE(*,*) ' nyG1 + nyG3 = nyG2 + nyG4 = ny_coarse' |
|---|
| 557 | WRITE(*,*) nyG1 + nyG3, ' = ', nyG2 + nyG4 |
|---|
| 558 | WRITE(*,*) '' |
|---|
| 559 | ! |
|---|
| 560 | nx_coarse = nxG1 + nxG2 |
|---|
| 561 | ny_coarse = nyG1 + nyG3 |
|---|
| 562 | ! |
|---|
| 563 | !!!Calculate size of mixed grid (nx x ny) |
|---|
| 564 | nxGmix = (nxG1 + nxG2) * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 565 | nxGmix = nxGmix + (rho-1)*(nxGmix-1) !nbre de points interpoler |
|---|
| 566 | ! |
|---|
| 567 | nyGmix = (nyG1 + nyG3) * 2 !nbre de pts connus (T,U,V,F) suivant y |
|---|
| 568 | nyGmix = nyGmix + (rho-1)*(nyGmix-1) !nbre de points interpoler |
|---|
| 569 | ! |
|---|
| 570 | WRITE(*,*) '*** SIZE OF MIXED GRID ***' |
|---|
| 571 | WRITE(*,*) nxGmix, ' x ', nyGmix |
|---|
| 572 | WRITE(*,*) '' |
|---|
| 573 | ! |
|---|
| 574 | !nx_fine = (nxGmix/2) - 1 |
|---|
| 575 | !ny_fine = (nyGmix/2) - 1 |
|---|
| 576 | nx_fine = (nx_coarse-2)*rho + 1 |
|---|
| 577 | ny_fine = (ny_coarse-2)*rho + 1 |
|---|
| 578 | |
|---|
| 579 | ! |
|---|
| 580 | WRITE(*,*) '*** SIZE OF FINE GRID ***' |
|---|
| 581 | WRITE(*,*) nx_fine, ' x ', ny_fine |
|---|
| 582 | WRITE(*,*) '' |
|---|
| 583 | ! |
|---|
| 584 | !!!Allocate mixed grid |
|---|
| 585 | CALL mixed_grid_allocate(Gmix,nxGmix,nyGmix) !from agrif_types |
|---|
| 586 | ! |
|---|
| 587 | !!!Calculate part of each grid to make Gmix |
|---|
| 588 | nxG1mix = nxG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 589 | nxG1mix = nxG1mix + (rho-1)*(nxG1mix-1) !nbre de points interpoler |
|---|
| 590 | ! |
|---|
| 591 | nyG1mix = nyG1 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 592 | nyG1mix = nyG1mix + (rho-1)*(nyG1mix-1) !nbre de points interpoler |
|---|
| 593 | print*,'nxG1mix= ', nxG1mix, 'nyG1mix= ', nyG1mix |
|---|
| 594 | ! |
|---|
| 595 | nxG2mix = nxG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 596 | nxG2mix = nxG2mix + (rho-1)*(nxG2mix-1) !nbre de points interpoler |
|---|
| 597 | ! |
|---|
| 598 | nyG2mix = nyG2 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 599 | nyG2mix = nyG2mix + (rho-1)*(nyG2mix-1) !nbre de points interpoler |
|---|
| 600 | print*,'nxG2mix= ', nxG2mix, 'nyG2mix= ', nyG2mix |
|---|
| 601 | ! |
|---|
| 602 | nxG3mix = nxG3 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 603 | nxG3mix = nxG3mix + (rho-1)*(nxG3mix-1) !nbre de points interpoler |
|---|
| 604 | ! |
|---|
| 605 | nyG3mix = nyG3 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 606 | nyG3mix = nyG3mix + (rho-1)*(nyG3mix-1) !nbre de points interpoler |
|---|
| 607 | print*,'nxG3mix= ', nxG3mix, 'nyG3mix= ', nyG3mix |
|---|
| 608 | ! |
|---|
| 609 | nxG4mix = nxG4 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 610 | nxG4mix = nxG4mix + (rho-1)*(nxG4mix-1) !nbre de points interpoler |
|---|
| 611 | ! |
|---|
| 612 | nyG4mix = nyG4 * 2 !nbre de pts connus (T,U,V,F) suivant x |
|---|
| 613 | nyG4mix = nyG4mix + (rho-1)*(nyG4mix-1) !nbre de points interpoler |
|---|
| 614 | print*,'nxG4mix= ', nxG4mix, 'nyG4mix= ', nyG4mix |
|---|
| 615 | ! |
|---|
| 616 | |
|---|
| 617 | !***On rcupre les pts depuis G1 |
|---|
| 618 | j_min = jmin-1 |
|---|
| 619 | DO j=1,nyG1mix,(2*rho) |
|---|
| 620 | i_min = imin-1 |
|---|
| 621 | DO i=1,nxG1mix,(2*rho) |
|---|
| 622 | Gmix%nav_lon(i,j) = G1%nav_lon(i_min,j_min) |
|---|
| 623 | Gmix%nav_lat(i+rho,j) = G1%nav_lat(i_min,j_min) |
|---|
| 624 | ! |
|---|
| 625 | Gmix%glam(i,j) = G1%glamt(i_min,j_min) |
|---|
| 626 | Gmix%glam(i+rho,j) = G1%glamu(i_min,j_min) |
|---|
| 627 | Gmix%glam(i,j+rho) = G1%glamv(i_min,j_min) |
|---|
| 628 | Gmix%glam(i+rho,j+rho) = G1%glamf(i_min,j_min) |
|---|
| 629 | ! |
|---|
| 630 | Gmix%gphi(i,j) = G1%gphit(i_min,j_min) |
|---|
| 631 | Gmix%gphi(i+rho,j) = G1%gphiu(i_min,j_min) |
|---|
| 632 | Gmix%gphi(i,j+rho) = G1%gphiv(i_min,j_min) |
|---|
| 633 | Gmix%gphi(i+rho,j+rho) = G1%gphif(i_min,j_min) |
|---|
| 634 | ! |
|---|
| 635 | Gmix%e1(i,j) = G1%e1t(i_min,j_min) |
|---|
| 636 | Gmix%e1(i+rho,j) = G1%e1u(i_min,j_min) |
|---|
| 637 | Gmix%e1(i,j+rho) = G1%e1v(i_min,j_min) |
|---|
| 638 | Gmix%e1(i+rho,j+rho) = G1%e1f(i_min,j_min) |
|---|
| 639 | ! |
|---|
| 640 | Gmix%e2(i,j) = G1%e2t(i_min,j_min) |
|---|
| 641 | Gmix%e2(i+rho,j) = G1%e2u(i_min,j_min) |
|---|
| 642 | Gmix%e2(i,j+rho) = G1%e2v(i_min,j_min) |
|---|
| 643 | Gmix%e2(i+rho,j+rho) = G1%e2f(i_min,j_min) |
|---|
| 644 | ! |
|---|
| 645 | i_min = i_min+1 |
|---|
| 646 | ENDDO |
|---|
| 647 | j_min = j_min+1 |
|---|
| 648 | ENDDO |
|---|
| 649 | ! |
|---|
| 650 | !***On rcupre les pts depuis G2 |
|---|
| 651 | j_min = jmin - 1 |
|---|
| 652 | DO j=1,nyG2mix,(2*rho) |
|---|
| 653 | i_min = 3 |
|---|
| 654 | DO k=i,nxGmix,(2*rho) |
|---|
| 655 | Gmix%nav_lon(k,j) = G2%nav_lon(i_min,j_min) |
|---|
| 656 | Gmix%nav_lat(k+rho,j) = G2%nav_lat(i_min,j_min) |
|---|
| 657 | ! |
|---|
| 658 | Gmix%glam(k,j) = G2%glamt(i_min,j_min) |
|---|
| 659 | Gmix%glam(k+rho,j) = G2%glamu(i_min,j_min) |
|---|
| 660 | Gmix%glam(k,j+rho) = G2%glamv(i_min,j_min) |
|---|
| 661 | Gmix%glam(k+rho,j+rho) = G2%glamf(i_min,j_min) |
|---|
| 662 | ! |
|---|
| 663 | Gmix%gphi(k,j) = G2%gphit(i_min,j_min) |
|---|
| 664 | Gmix%gphi(k+rho,j) = G2%gphiu(i_min,j_min) |
|---|
| 665 | Gmix%gphi(k,j+rho) = G2%gphiv(i_min,j_min) |
|---|
| 666 | Gmix%gphi(k+rho,j+rho) = G2%gphif(i_min,j_min) |
|---|
| 667 | ! |
|---|
| 668 | Gmix%e1(k,j) = G2%e1t(i_min,j_min) |
|---|
| 669 | Gmix%e1(k+rho,j) = G2%e1u(i_min,j_min) |
|---|
| 670 | Gmix%e1(k,j+rho) = G2%e1v(i_min,j_min) |
|---|
| 671 | Gmix%e1(k+rho,j+rho) = G2%e1f(i_min,j_min) |
|---|
| 672 | ! |
|---|
| 673 | Gmix%e2(k,j) = G2%e2t(i_min,j_min) |
|---|
| 674 | Gmix%e2(k+rho,j) = G2%e2u(i_min,j_min) |
|---|
| 675 | Gmix%e2(k,j+rho) = G2%e2v(i_min,j_min) |
|---|
| 676 | Gmix%e2(k+rho,j+rho) = G2%e2f(i_min,j_min) |
|---|
| 677 | ! |
|---|
| 678 | i_min = i_min+1 |
|---|
| 679 | ENDDO |
|---|
| 680 | j_min = j_min+1 |
|---|
| 681 | ENDDO |
|---|
| 682 | ! |
|---|
| 683 | !**On rcupre les pts depuis G3 |
|---|
| 684 | j_min = SIZE(G3%glamt,2)-2 !on supprime les bandes de chevauchement |
|---|
| 685 | DO m=j,nyGmix,(2*rho) |
|---|
| 686 | i_min = imin + imax |
|---|
| 687 | DO i=1,nxG3mix,(2*rho) |
|---|
| 688 | Gmix%nav_lon(i,m) = G3%nav_lon(i_min,j_min) |
|---|
| 689 | Gmix%nav_lat(i+rho,m) = G3%nav_lat(i_min,j_min) |
|---|
| 690 | ! |
|---|
| 691 | Gmix%glam(i,m) = G3%glamt(i_min,j_min) |
|---|
| 692 | Gmix%glam(i+rho,m) = G3%glamu(i_min,j_min) |
|---|
| 693 | Gmix%glam(i,m+rho) = G3%glamv(i_min,j_min) |
|---|
| 694 | Gmix%glam(i+rho,m+rho) = G3%glamf(i_min,j_min) |
|---|
| 695 | ! |
|---|
| 696 | Gmix%gphi(i,m) = G3%gphit(i_min,j_min) |
|---|
| 697 | Gmix%gphi(i+rho,m) = G3%gphiu(i_min,j_min) |
|---|
| 698 | Gmix%gphi(i,m+rho) = G3%gphiv(i_min,j_min) |
|---|
| 699 | Gmix%gphi(i+rho,m+rho) = G3%gphif(i_min,j_min) |
|---|
| 700 | ! |
|---|
| 701 | Gmix%e1(i,m) = G3%e1t(i_min,j_min) |
|---|
| 702 | Gmix%e1(i+rho,m) = G3%e1u(i_min,j_min) |
|---|
| 703 | Gmix%e1(i,m+rho) = G3%e1v(i_min,j_min) |
|---|
| 704 | Gmix%e1(i+rho,m+rho) = G3%e1f(i_min,j_min) |
|---|
| 705 | ! |
|---|
| 706 | Gmix%e2(i,m) = G3%e2t(i_min,j_min) |
|---|
| 707 | Gmix%e2(i+rho,m) = G3%e2u(i_min,j_min) |
|---|
| 708 | Gmix%e2(i,m+rho) = G3%e2v(i_min,j_min) |
|---|
| 709 | Gmix%e2(i+rho,m+rho) = G3%e2f(i_min,j_min) |
|---|
| 710 | ! |
|---|
| 711 | i_min = i_min - 1 !on se dplace le long de (-i) |
|---|
| 712 | ENDDO |
|---|
| 713 | j_min = j_min - 1 !on se dplace le long de (-j) |
|---|
| 714 | ENDDO |
|---|
| 715 | ! |
|---|
| 716 | !**On rcupre les pts depuis G4 |
|---|
| 717 | j_min = SIZE(G4%glamt,2)-2 !on supprime les bandes de chevauchement |
|---|
| 718 | DO m=j,nyGmix,(2*rho) |
|---|
| 719 | i_min = SIZE(G4%glamt,1)-2 |
|---|
| 720 | DO k=i,nxGmix,(2*rho) |
|---|
| 721 | Gmix%nav_lon(k,m) = G4%nav_lon(i_min,j_min) |
|---|
| 722 | Gmix%nav_lat(k+rho,m) = G4%nav_lat(i_min,j_min) |
|---|
| 723 | ! |
|---|
| 724 | Gmix%glam(k,m) = G4%glamt(i_min,j_min) |
|---|
| 725 | Gmix%glam(k+rho,m) = G4%glamu(i_min,j_min) |
|---|
| 726 | Gmix%glam(k,m+rho) = G4%glamv(i_min,j_min) |
|---|
| 727 | Gmix%glam(k+rho,m+rho) = G4%glamf(i_min,j_min) |
|---|
| 728 | ! |
|---|
| 729 | Gmix%gphi(k,m) = G4%gphit(i_min,j_min) |
|---|
| 730 | Gmix%gphi(k+rho,m) = G4%gphiu(i_min,j_min) |
|---|
| 731 | Gmix%gphi(k,m+rho) = G4%gphiv(i_min,j_min) |
|---|
| 732 | Gmix%gphi(k+rho,m+rho) = G4%gphif(i_min,j_min) |
|---|
| 733 | ! |
|---|
| 734 | Gmix%e1(k,m) = G4%e1t(i_min,j_min) |
|---|
| 735 | Gmix%e1(k+rho,m) = G4%e1u(i_min,j_min) |
|---|
| 736 | Gmix%e1(k,m+rho) = G4%e1v(i_min,j_min) |
|---|
| 737 | Gmix%e1(k+rho,m+rho) = G4%e1f(i_min,j_min) |
|---|
| 738 | ! |
|---|
| 739 | Gmix%e2(k,m) = G4%e2t(i_min,j_min) |
|---|
| 740 | Gmix%e2(k+rho,m) = G4%e2u(i_min,j_min) |
|---|
| 741 | Gmix%e2(k,m+rho) = G4%e2v(i_min,j_min) |
|---|
| 742 | Gmix%e2(k+rho,m+rho) = G4%e2f(i_min,j_min) |
|---|
| 743 | ! |
|---|
| 744 | i_min = i_min - 1 !on se dplace le long de (-i) |
|---|
| 745 | ENDDO |
|---|
| 746 | j_min = j_min - 1 !on se dplace le long de (-j) |
|---|
| 747 | ENDDO |
|---|
| 748 | ! |
|---|
| 749 | print*, 'G1%glamt= ' |
|---|
| 750 | DO j=jmin-1,SIZE(G1%glamt,2) |
|---|
| 751 | print*, G1%glamt(imin-1:SIZE(G1%glamt,1),j) |
|---|
| 752 | ENDDO |
|---|
| 753 | print*,'' |
|---|
| 754 | print*, 'G1%glamu= ' |
|---|
| 755 | DO j=jmin-1,SIZE(G1%glamu,2) |
|---|
| 756 | print*, G1%glamu(imin-1:SIZE(G1%glamu,1),j) |
|---|
| 757 | ENDDO |
|---|
| 758 | print*,'' |
|---|
| 759 | print*, 'Gmix%glam= ' |
|---|
| 760 | DO j=1,nyGmix |
|---|
| 761 | print*, Gmix%glam(:,j) |
|---|
| 762 | ENDDO |
|---|
| 763 | END SUBROUTINE |
|---|
| 764 | ! |
|---|
| 765 | ! |
|---|
| 766 | !******************************************************** |
|---|
| 767 | ! SUBROUTINE interp * |
|---|
| 768 | ! * |
|---|
| 769 | ! calculate polynomial interpolation at 4th order * |
|---|
| 770 | ! * |
|---|
| 771 | ! CALLED from create_coordinates.f90 * |
|---|
| 772 | !******************************************************** |
|---|
| 773 | ! |
|---|
| 774 | SUBROUTINE interp_grid(Gmix) |
|---|
| 775 | ! |
|---|
| 776 | TYPE(mixed_coordinates) :: Gmix |
|---|
| 777 | !TYPE(Coordinates) :: Grid1 |
|---|
| 778 | REAL*8, DIMENSION(rho-1,4) :: S !Array to store the coefficients of Lagrange |
|---|
| 779 | INTEGER :: i, j, k, status |
|---|
| 780 | ! |
|---|
| 781 | WRITE(*,*) '' |
|---|
| 782 | WRITE(*,*) '*** ROUTINE interp ***' |
|---|
| 783 | WRITE(*,*) '' |
|---|
| 784 | ! |
|---|
| 785 | !!!Calculate coefficients |
|---|
| 786 | status = pol_coef(S) |
|---|
| 787 | ! |
|---|
| 788 | !IF(rho>1) THEN |
|---|
| 789 | !!!Interpolation along longitude |
|---|
| 790 | do j=1,SIZE(Gmix%glam,2),rho |
|---|
| 791 | do i=1,SIZE(Gmix%glam,1),rho |
|---|
| 792 | do k=1,rho-1 |
|---|
| 793 | Gmix%glam(i+rho+k,j) = S(k,1) * Gmix%glam(i,j) & |
|---|
| 794 | + S(k,2) * Gmix%glam(i+1*rho,j) & |
|---|
| 795 | + S(k,3) * Gmix%glam(i+2*rho,j) & |
|---|
| 796 | + S(k,4) * Gmix%glam(i+3*rho,j) |
|---|
| 797 | ! |
|---|
| 798 | Gmix%gphi(i+rho+k,j) = S(k,1) * Gmix%gphi(i,j) & |
|---|
| 799 | + S(k,2) * Gmix%gphi(i+1*rho,j) & |
|---|
| 800 | + S(k,3) * Gmix%gphi(i+2*rho,j) & |
|---|
| 801 | + S(k,4) * Gmix%gphi(i+3*rho,j) |
|---|
| 802 | ! |
|---|
| 803 | Gmix%e1(i+rho+k,j) = S(k,1) * Gmix%e1(i,j) & |
|---|
| 804 | + S(k,2) * Gmix%e1(i+1*rho,j) & |
|---|
| 805 | + S(k,3) * Gmix%e1(i+2*rho,j) & |
|---|
| 806 | + S(k,4) * Gmix%e1(i+3*rho,j) |
|---|
| 807 | ! |
|---|
| 808 | Gmix%e2(i+rho+k,j) = S(k,1) * Gmix%e2(i,j) & |
|---|
| 809 | + S(k,2) * Gmix%e2(i+1*rho,j) & |
|---|
| 810 | + S(k,3) * Gmix%e2(i+2*rho,j) & |
|---|
| 811 | + S(k,4) * Gmix%e2(i+3*rho,j) |
|---|
| 812 | ! |
|---|
| 813 | Gmix%nav_lon(i+rho+k,j) = Gmix%glam(i+rho+k,j) |
|---|
| 814 | Gmix%nav_lat(i+rho+k,j) = Gmix%gphi(i+rho+k,j) |
|---|
| 815 | ! |
|---|
| 816 | end do |
|---|
| 817 | ! |
|---|
| 818 | IF(i+3*rho == SIZE(Gmix%glam,1)) EXIT |
|---|
| 819 | end do |
|---|
| 820 | end do |
|---|
| 821 | ! |
|---|
| 822 | !!!Interpolation along latitude |
|---|
| 823 | do i=1,SIZE(Gmix%glam,1) |
|---|
| 824 | do j=1,SIZE(Gmix%glam,2),rho |
|---|
| 825 | do k=1,rho-1 |
|---|
| 826 | Gmix%glam(i,j+rho+k) = S(k,1) * Gmix%glam(i,j) & |
|---|
| 827 | + S(k,2) * Gmix%glam(i,j+rho) & |
|---|
| 828 | + S(k,3) * Gmix%glam(i,j+2*rho) & |
|---|
| 829 | + S(k,4) * Gmix%glam(i,j+3*rho) |
|---|
| 830 | ! |
|---|
| 831 | Gmix%gphi(i,j+rho+k) = S(k,1) * Gmix%gphi(i,j) & |
|---|
| 832 | + S(k,2) * Gmix%gphi(i,j+rho) & |
|---|
| 833 | + S(k,3) * Gmix%gphi(i,j+2*rho) & |
|---|
| 834 | + S(k,4) * Gmix%gphi(i,j+3*rho) |
|---|
| 835 | ! |
|---|
| 836 | Gmix%e1(i,j+rho+k) = S(k,1) * Gmix%e1(i,j) & |
|---|
| 837 | + S(k,2) * Gmix%e1(i,j+rho) & |
|---|
| 838 | + S(k,3) * Gmix%e1(i,j+2*rho) & |
|---|
| 839 | + S(k,4) * Gmix%e1(i,j+3*rho) |
|---|
| 840 | ! |
|---|
| 841 | Gmix%e2(i,j+rho+k) = S(k,1) * Gmix%e2(i,j) & |
|---|
| 842 | + S(k,2) * Gmix%e2(i,j+rho) & |
|---|
| 843 | + S(k,3) * Gmix%e2(i,j+2*rho) & |
|---|
| 844 | + S(k,4) * Gmix%e2(i,j+3*rho) |
|---|
| 845 | ! |
|---|
| 846 | Gmix%nav_lon(i,j+rho+k) = Gmix%glam(i,j+rho+k) |
|---|
| 847 | Gmix%nav_lat(i,j+rho+k) = Gmix%gphi(i,j+rho+k) |
|---|
| 848 | ! |
|---|
| 849 | end do |
|---|
| 850 | ! |
|---|
| 851 | IF(j+3*rho == SIZE(Gmix%glam,2)) EXIT |
|---|
| 852 | end do |
|---|
| 853 | end do |
|---|
| 854 | |
|---|
| 855 | ! |
|---|
| 856 | |
|---|
| 857 | END SUBROUTINE |
|---|
| 858 | ! |
|---|
| 859 | ! |
|---|
| 860 | !******************************************************** |
|---|
| 861 | ! FUNCTION pol_coef * |
|---|
| 862 | ! * |
|---|
| 863 | ! calculate the coefficients of Lagrange * |
|---|
| 864 | ! for the polynomial interpolation * |
|---|
| 865 | ! * |
|---|
| 866 | ! CALLED from SUBROUTINE interp * |
|---|
| 867 | !******************************************************** |
|---|
| 868 | ! |
|---|
| 869 | REAL FUNCTION pol_coef(vect) |
|---|
| 870 | ! |
|---|
| 871 | REAL*8, DIMENSION(rho-1,4) :: vect |
|---|
| 872 | REAL*8, DIMENSION(3) :: v |
|---|
| 873 | INTEGER :: i, m, k |
|---|
| 874 | REAL*8 :: x0 !position relative du point calculer |
|---|
| 875 | INTEGER :: x_k, x_i !position relative des points utiliss pour l'interpolation |
|---|
| 876 | REAL*8 :: eps |
|---|
| 877 | ! |
|---|
| 878 | !on parle de position relative puisque nous utilisons les positions |
|---|
| 879 | !indiciaires, lesquelles sont rptes dans toute la grille. |
|---|
| 880 | !Il n'est donc ncessaire de calculer qu'une fois les 4 coefficients |
|---|
| 881 | !qui seront utiliss dans toute la grille en fonction de rho |
|---|
| 882 | ! |
|---|
| 883 | ! |
|---|
| 884 | WRITE(*,*) '' |
|---|
| 885 | WRITE(*,*) '*** FUNCTION pol_coef ***' |
|---|
| 886 | WRITE(*,*) '' |
|---|
| 887 | ! |
|---|
| 888 | m=1 |
|---|
| 889 | eps = 1.-1e-8 |
|---|
| 890 | ! |
|---|
| 891 | do k=1,rho-1 |
|---|
| 892 | x0=rho+1+k |
|---|
| 893 | i=1 |
|---|
| 894 | do x_i=1,4+3*(rho-1),rho |
|---|
| 895 | m=1 |
|---|
| 896 | do x_k=1,4+3*(rho-1),rho |
|---|
| 897 | IF(x_k == x_i) THEN |
|---|
| 898 | CYCLE |
|---|
| 899 | ELSE |
|---|
| 900 | v(m) = (x0-x_k) / (x_i-x_k) |
|---|
| 901 | m=m+1 |
|---|
| 902 | END IF |
|---|
| 903 | end do |
|---|
| 904 | vect(k,i) = product(v) |
|---|
| 905 | i=i+1 |
|---|
| 906 | end do |
|---|
| 907 | end do |
|---|
| 908 | ! |
|---|
| 909 | IF((SUM(vect)<eps .OR. SUM(vect)>eps) .AND. rho>1) THEN |
|---|
| 910 | print*,'' |
|---|
| 911 | print*, '*** CHECK LAGRANGE COEFFICIENTS: ***' |
|---|
| 912 | print*,'' |
|---|
| 913 | do i=1,rho-1 |
|---|
| 914 | print*,'point #',i |
|---|
| 915 | print*, 'S(i,:)= ', vect(i,:) |
|---|
| 916 | print*, 'SUM(S(i,:)) =', SUM(vect(i,:)) |
|---|
| 917 | print*,'' |
|---|
| 918 | end do |
|---|
| 919 | print*, '' |
|---|
| 920 | pol_coef = 1 |
|---|
| 921 | ELSE |
|---|
| 922 | !print*,'Error with Lagrange coefficients' |
|---|
| 923 | pol_coef = 0 |
|---|
| 924 | END IF |
|---|
| 925 | ! |
|---|
| 926 | END FUNCTION pol_coef |
|---|
| 927 | ! |
|---|
| 928 | ! |
|---|
| 929 | !******************************************************** |
|---|
| 930 | ! SUBROUTINE alloc_child_grid * |
|---|
| 931 | ! * |
|---|
| 932 | ! create the child grid from mixed grid * |
|---|
| 933 | ! * |
|---|
| 934 | ! CALLED from create_coordinates.f90 * |
|---|
| 935 | !******************************************************** |
|---|
| 936 | ! |
|---|
| 937 | SUBROUTINE alloc_child_grid(Gmix, Grid1) |
|---|
| 938 | ! |
|---|
| 939 | TYPE(mixed_coordinates), INTENT(IN) :: Gmix |
|---|
| 940 | TYPE(coordinates), INTENT(INOUT) :: Grid1 |
|---|
| 941 | INTEGER :: i, j, p, q |
|---|
| 942 | ! |
|---|
| 943 | WRITE(*,*) '' |
|---|
| 944 | WRITE(*,*) '*** ROUTINE alloc_child_grid ***' |
|---|
| 945 | WRITE(*,*) '' |
|---|
| 946 | ! |
|---|
| 947 | ! |
|---|
| 948 | IF(rho>1) THEN |
|---|
| 949 | q=1 |
|---|
| 950 | DO j=rho+2,(SIZE(Gmix%glam,2)-(rho)),2 |
|---|
| 951 | p=1 |
|---|
| 952 | DO i=rho+2,(SIZE(Gmix%glam,1)-(rho)),2 |
|---|
| 953 | ! |
|---|
| 954 | Grid1%nav_lon(p,q) = Gmix%nav_lon(i,j) |
|---|
| 955 | Grid1%nav_lat(p,q) = Gmix%nav_lat(i,j) |
|---|
| 956 | ! |
|---|
| 957 | Grid1%glamt(p,q) = Gmix%glam(i,j) |
|---|
| 958 | Grid1%glamu(p,q) = Gmix%glam(i+1,j) |
|---|
| 959 | Grid1%glamv(p,q) = Gmix%glam(i,j+1) |
|---|
| 960 | Grid1%glamf(p,q) = Gmix%glam(i+1,j+1) |
|---|
| 961 | ! |
|---|
| 962 | Grid1%gphit(p,q) = Gmix%gphi(i,j) |
|---|
| 963 | Grid1%gphiu(p,q) = Gmix%gphi(i+1,j) |
|---|
| 964 | Grid1%gphiv(p,q) = Gmix%gphi(i,j+1) |
|---|
| 965 | Grid1%gphif(p,q) = Gmix%gphi(i+1,j+1) |
|---|
| 966 | ! |
|---|
| 967 | Grid1%e1t(p,q) = Gmix%e1(i,j) |
|---|
| 968 | Grid1%e1u(p,q) = Gmix%e1(i+1,j) |
|---|
| 969 | Grid1%e1v(p,q) = Gmix%e1(i,j+1) |
|---|
| 970 | Grid1%e1f(p,q) = Gmix%e1(i+1,j+1) |
|---|
| 971 | ! |
|---|
| 972 | Grid1%e2t(p,q) = Gmix%e2(i,j) |
|---|
| 973 | Grid1%e2u(p,q) = Gmix%e2(i+1,j) |
|---|
| 974 | Grid1%e2v(p,q) = Gmix%e2(i,j+1) |
|---|
| 975 | Grid1%e2f(p,q) = Gmix%e2(i+1,j+1) |
|---|
| 976 | ! |
|---|
| 977 | p=p+1 |
|---|
| 978 | END DO |
|---|
| 979 | q=q+1 |
|---|
| 980 | END DO |
|---|
| 981 | ELSE |
|---|
| 982 | q=1 |
|---|
| 983 | DO j=1,SIZE(Gmix%glam,2),2 |
|---|
| 984 | p=1 |
|---|
| 985 | DO i=1,SIZE(Gmix%glam,1),2 |
|---|
| 986 | ! |
|---|
| 987 | Grid1%nav_lon(p,q) = Gmix%nav_lon(i,j) |
|---|
| 988 | Grid1%nav_lat(p,q) = Gmix%nav_lat(i+1,j) |
|---|
| 989 | ! |
|---|
| 990 | Grid1%glamt(p,q) = Gmix%glam(i,j) |
|---|
| 991 | Grid1%glamu(p,q) = Gmix%glam(i+1,j) |
|---|
| 992 | Grid1%glamv(p,q) = Gmix%glam(i,j+1) |
|---|
| 993 | Grid1%glamf(p,q) = Gmix%glam(i+1,j+1) |
|---|
| 994 | ! |
|---|
| 995 | Grid1%gphit(p,q) = Gmix%gphi(i,j) |
|---|
| 996 | Grid1%gphiu(p,q) = Gmix%gphi(i+1,j) |
|---|
| 997 | Grid1%gphiv(p,q) = Gmix%gphi(i,j+1) |
|---|
| 998 | Grid1%gphif(p,q) = Gmix%gphi(i+1,j+1) |
|---|
| 999 | ! |
|---|
| 1000 | Grid1%e1t(p,q) = Gmix%e1(i,j) |
|---|
| 1001 | Grid1%e1u(p,q) = Gmix%e1(i+1,j) |
|---|
| 1002 | Grid1%e1v(p,q) = Gmix%e1(i,j+1) |
|---|
| 1003 | Grid1%e1f(p,q) = Gmix%e1(i+1,j+1) |
|---|
| 1004 | ! |
|---|
| 1005 | Grid1%e2t(p,q) = Gmix%e2(i,j) |
|---|
| 1006 | Grid1%e2u(p,q) = Gmix%e2(i+1,j) |
|---|
| 1007 | Grid1%e2v(p,q) = Gmix%e2(i,j+1) |
|---|
| 1008 | Grid1%e2f(p,q) = Gmix%e2(i+1,j+1) |
|---|
| 1009 | ! |
|---|
| 1010 | p=p+1 |
|---|
| 1011 | END DO |
|---|
| 1012 | q=q+1 |
|---|
| 1013 | END DO |
|---|
| 1014 | ENDIF |
|---|
| 1015 | |
|---|
| 1016 | WRITE(*,*) '' |
|---|
| 1017 | WRITE(*,*) 'Size of the Child grid: ', nx_fine, ' x ', ny_fine |
|---|
| 1018 | WRITE(*,*) '' |
|---|
| 1019 | print*, 'Grid1%nav_lat= ' |
|---|
| 1020 | DO j=1,ny_fine |
|---|
| 1021 | print*, Grid1%nav_lat(:,j) |
|---|
| 1022 | END DO |
|---|
| 1023 | ! |
|---|
| 1024 | END SUBROUTINE alloc_child_grid |
|---|
| 1025 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 1026 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 1027 | END MODULE tools_brice |
|---|
