[2136] | 1 | MODULE mixed_grid |
---|
| 2 | !!----------------------------------------------------------- |
---|
| 3 | !! |
---|
| 4 | !! tools box to create a mixed grid storing |
---|
| 5 | !! the known values of grids U,V,T,F |
---|
| 6 | !! |
---|
| 7 | !! Created by Brice Lemaire on 01/2010. |
---|
| 8 | !! |
---|
| 9 | !!----------------------------------------------------------- |
---|
| 10 | USE readwrite |
---|
| 11 | ! |
---|
| 12 | IMPLICIT NONE |
---|
| 13 | PUBLIC |
---|
| 14 | ! |
---|
| 15 | CONTAINS |
---|
| 16 | !******************************************************** |
---|
| 17 | ! SUBROUTINE define_mixed_grid * |
---|
| 18 | ! * |
---|
| 19 | ! to define the size of the mixed grid * |
---|
| 20 | ! * |
---|
| 21 | ! CALL from create_coordinates * |
---|
| 22 | !******************************************************** |
---|
| 23 | SUBROUTINE define_mixed_grid |
---|
| 24 | ! |
---|
| 25 | INTEGER :: ixgmix, iygmix |
---|
| 26 | INTEGER :: ii, ij |
---|
| 27 | ! |
---|
| 28 | WRITE(*,*) '' |
---|
| 29 | WRITE(*,*) ' ### SUBROUTINE define_mixed_grid ### ' |
---|
| 30 | WRITE(*,*) '' |
---|
| 31 | ! |
---|
| 32 | WRITE(*,*) ' *** CHECKING SIZE OF COARSE DOMAIN *** ' |
---|
| 33 | WRITE(*,*) nxcoag, 'x', nycoag |
---|
| 34 | WRITE(*,*) '' |
---|
| 35 | ! |
---|
| 36 | !************************************* |
---|
| 37 | !!!Calculate size of mixed grid (ixgmix x iygmix) |
---|
| 38 | !************************************* |
---|
| 39 | IF(.NOT.nglobal) THEN |
---|
| 40 | ixgmix = (nxcoag) * 2 !known points (T,U,V,F) along x |
---|
| 41 | ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)!-1) !points to interpolate '' |
---|
| 42 | ! |
---|
| 43 | iygmix = (nycoag) * 2 !known points (T,U,V,F) along y |
---|
| 44 | iygmix = iygmix + (nn_rhoy-1)*(iygmix)!-1) !points to interpolate '' |
---|
| 45 | ELSEIF(nglobal) THEN |
---|
| 46 | ixgmix = (nxcoag) * 2 |
---|
| 47 | ixgmix = ixgmix + (nn_rhox-1)*(ixgmix) |
---|
| 48 | ! |
---|
| 49 | iygmix = (nycoag) * 2 |
---|
| 50 | iygmix = iygmix + (nn_rhoy-1)*(iygmix) |
---|
| 51 | ENDIF |
---|
| 52 | ! |
---|
| 53 | nxgmix = ixgmix |
---|
| 54 | nygmix = iygmix |
---|
| 55 | ! |
---|
| 56 | WRITE(*,*) '' |
---|
| 57 | WRITE(*,*) '*** SIZE OF MIXED GRID ***' |
---|
| 58 | WRITE(*,*) nxgmix, ' x ', nygmix |
---|
| 59 | WRITE(*,*) '' |
---|
| 60 | ! |
---|
| 61 | CALL mixed_grid_allocate(smixgrd,ixgmix,iygmix) !using type.f90 |
---|
| 62 | ! |
---|
| 63 | IF(nglobal)THEN |
---|
| 64 | ii = 1 |
---|
| 65 | ij = 1 |
---|
| 66 | ELSE |
---|
| 67 | ii = nn_imin-1 |
---|
| 68 | ij = nn_jmin-1 |
---|
| 69 | ENDIF |
---|
| 70 | ! |
---|
| 71 | CALL write_mixed_grid(ixgmix,iygmix,ii,ij) |
---|
| 72 | ! |
---|
| 73 | WRITE(*,*) '' |
---|
| 74 | WRITE(*,*) ' ### END SUBROUTINE define_mixed_grid ### ' |
---|
| 75 | WRITE(*,*) '' |
---|
| 76 | ! |
---|
| 77 | END SUBROUTINE |
---|
| 78 | ! |
---|
| 79 | ! |
---|
| 80 | ! |
---|
| 81 | !******************************************************** |
---|
| 82 | ! SUBROUTINE write_mixed_grid * |
---|
| 83 | ! * |
---|
| 84 | ! to write the known values into the mixed grid * |
---|
| 85 | ! These known values are spaced every (nn_rho-1) points * |
---|
| 86 | ! for allowing to compute the interpolation * |
---|
| 87 | ! inside this same grid * |
---|
| 88 | ! * |
---|
| 89 | !******************************************************** |
---|
| 90 | SUBROUTINE write_mixed_grid(ki_end,kj_end,ki_min,kj_min) |
---|
| 91 | ! |
---|
| 92 | INTEGER, INTENT(IN) :: ki_end, kj_end |
---|
| 93 | INTEGER, INTENT(INOUT) :: ki_min, kj_min |
---|
| 94 | INTEGER :: ji_start, jj_start |
---|
| 95 | INTEGER :: ji,jj |
---|
| 96 | INTEGER :: isym_x, isym_y |
---|
| 97 | INTEGER :: itmp1, itmp2, itmp3, itmp4, itmp5, itmp6, itmp7 |
---|
| 98 | INTEGER :: icorrxt, icorrxu, icorrxv, icorrxf !correction factor for i-indexation |
---|
| 99 | INTEGER :: icorryt, icorryu, icorryv, icorryf !correction factor for j-indexation |
---|
| 100 | LOGICAL :: llp = .TRUE. |
---|
| 101 | LOGICAL :: llq = .TRUE. |
---|
| 102 | ! |
---|
| 103 | WRITE(*,*) '' |
---|
| 104 | WRITE(*,*) ' ### SUBROUTINE write_mixed_grid ### ' |
---|
| 105 | WRITE(*,*) '' |
---|
| 106 | ! |
---|
| 107 | ji_start = 1 |
---|
| 108 | jj_start = 1 |
---|
| 109 | ! |
---|
| 110 | isym_y = 1 |
---|
| 111 | ! |
---|
| 112 | ! correction factor for symmetry along north boundary |
---|
| 113 | icorrxt = 0 |
---|
| 114 | icorrxu = 0 |
---|
| 115 | icorrxv = 0 |
---|
| 116 | icorrxf = 0 |
---|
| 117 | ! |
---|
| 118 | icorryt = 0 |
---|
| 119 | icorryu = 0 |
---|
| 120 | icorryv = 0 |
---|
| 121 | icorryf = 0 |
---|
| 122 | ! |
---|
| 123 | DO jj=nn_rhoy,kj_end,2*nn_rhoy |
---|
| 124 | ! |
---|
| 125 | DO ji=nn_rhox,ki_end,2*nn_rhox |
---|
| 126 | ! |
---|
| 127 | smixgrd%nav_lon(ji,jj) = scoagrd%nav_lon(ki_min + icorrxt, kj_min + icorryt) |
---|
| 128 | smixgrd%nav_lat(ji,jj) = scoagrd%nav_lat(ki_min + icorrxt, kj_min + icorryt) |
---|
| 129 | ! |
---|
| 130 | smixgrd%glam(ji,jj) = scoagrd%glamt(ki_min + icorrxt, kj_min + icorryt) |
---|
| 131 | smixgrd%glam(ji+nn_rhox,jj) = scoagrd%glamu(ki_min + icorrxu, kj_min + icorryu) |
---|
| 132 | smixgrd%glam(ji,jj+nn_rhoy) = scoagrd%glamv(ki_min + icorrxv, kj_min + icorryv) |
---|
| 133 | smixgrd%glam(ji+nn_rhox,jj+nn_rhoy) = scoagrd%glamf(ki_min + icorrxf, kj_min + icorryf) |
---|
| 134 | ! |
---|
| 135 | smixgrd%gphi(ji,jj) = scoagrd%gphit(ki_min + icorrxt, kj_min + icorryt) |
---|
| 136 | smixgrd%gphi(ji+nn_rhox,jj) = scoagrd%gphiu(ki_min + icorrxu, kj_min + icorryu) |
---|
| 137 | smixgrd%gphi(ji,jj+nn_rhoy) = scoagrd%gphiv(ki_min + icorrxv, kj_min + icorryv) |
---|
| 138 | smixgrd%gphi(ji+nn_rhox,jj+nn_rhoy) = scoagrd%gphif(ki_min + icorrxf, kj_min + icorryf) |
---|
| 139 | ! |
---|
| 140 | smixgrd%e1(ji,jj) = scoagrd%e1t(ki_min + icorrxt, kj_min + icorryt) |
---|
| 141 | smixgrd%e1(ji+nn_rhox,jj) = scoagrd%e1u(ki_min + icorrxu, kj_min + icorryu) |
---|
| 142 | smixgrd%e1(ji,jj+nn_rhoy) = scoagrd%e1v(ki_min + icorrxv, kj_min + icorryv) |
---|
| 143 | smixgrd%e1(ji+nn_rhox,jj+nn_rhoy) = scoagrd%e1f(ki_min + icorrxf, kj_min + icorryf) |
---|
| 144 | ! |
---|
| 145 | smixgrd%e2(ji,jj) = scoagrd%e2t(ki_min + icorrxt, kj_min + icorryt) |
---|
| 146 | smixgrd%e2(ji+nn_rhox,jj) = scoagrd%e2u(ki_min + icorrxu, kj_min + icorryu) |
---|
| 147 | smixgrd%e2(ji,jj+nn_rhoy) = scoagrd%e2v(ki_min + icorrxv, kj_min + icorryv) |
---|
| 148 | smixgrd%e2(ji+nn_rhox,jj+nn_rhoy) = scoagrd%e2f(ki_min + icorrxf, kj_min + icorryf) |
---|
| 149 | ! |
---|
| 150 | IF(.NOT.nglobal)THEN |
---|
| 151 | IF(ki_min.EQ.nsizex.AND.nn_imin.NE.2) THEN ! across right/left boundary BUT not all around the earth |
---|
| 152 | ki_min = 3 |
---|
| 153 | ELSEIF(isym_y.EQ.1) THEN ! normal case |
---|
| 154 | ki_min = ki_min + 1 |
---|
| 155 | ELSEIF(isym_y.EQ.-1) THEN ! symetry along north boundary |
---|
| 156 | ki_min = ki_min - 1 |
---|
| 157 | ENDIF |
---|
| 158 | ELSE |
---|
| 159 | ki_min = ki_min + 1 |
---|
| 160 | ENDIF |
---|
| 161 | ! |
---|
| 162 | ENDDO |
---|
| 163 | ! |
---|
| 164 | ! |
---|
| 165 | ! when we reach north boundary |
---|
| 166 | IF(.NOT.nglobal)THEN |
---|
| 167 | IF(kj_min.EQ.nsizey-npivot-1.AND.llp) THEN ! npivot => pivot located on T-point or F-point |
---|
| 168 | llp = .FALSE. |
---|
| 169 | kj_min = nsizey |
---|
| 170 | isym_y = -1 |
---|
| 171 | IF(nn_imin.LT.nmid.AND.nn_imax.LT.nmid) THEN ! no bipole (from Asia to Canada) |
---|
| 172 | itmp1 = nsizex - nn_imin + 2 + npivot |
---|
| 173 | isym_x = 1 |
---|
| 174 | ELSEIF(nn_imin.GT.nmid.AND.nn_imax.GT.nmid) THEN ! no bipole (from Canada to Asia) |
---|
| 175 | itmp2 = nsizex - nn_imin + 2 + npivot |
---|
| 176 | isym_x = 2 |
---|
| 177 | ELSEIF(nn_imin.LT.nmid.AND.nn_imax.GT.nmid) THEN ! canadian bipole |
---|
| 178 | IF(nval1.LT.nval2) THEN |
---|
| 179 | itmp3 = nmid + nval2 |
---|
| 180 | isym_x = 3 |
---|
| 181 | ELSEIF(nval1.GE.nval2) THEN ! canadian bipole |
---|
| 182 | itmp4 = nmid + nval1 + 2 - npivot |
---|
| 183 | isym_x = 4 |
---|
| 184 | ENDIF |
---|
| 185 | ELSEIF(ki_min.EQ.nsizex.AND.nval1.GT.nval2) THEN ! asian bipole |
---|
| 186 | itmp5 = nval1 + 1 + npivot |
---|
| 187 | isym_x = 5 |
---|
| 188 | ELSEIF(ki_min.EQ.nsizex.AND.nval1.LT.nval2) THEN ! asian bipole |
---|
| 189 | itmp6 = nval2 + 1 |
---|
| 190 | isym_x = 6 |
---|
| 191 | ELSEIF(ki_min.GE.nmid) THEN ! all around the earth (2 bipoles) |
---|
| 192 | itmp7 = nsizex |
---|
| 193 | isym_x = 7 |
---|
| 194 | ENDIF |
---|
| 195 | ENDIF |
---|
| 196 | ! |
---|
| 197 | ! |
---|
| 198 | ! |
---|
| 199 | IF(isym_y.EQ.1) THEN |
---|
| 200 | kj_min = kj_min + 1 ! cas normal |
---|
| 201 | ki_min = nn_imin - 1 |
---|
| 202 | ELSEIF(isym_y.EQ.-1) THEN |
---|
| 203 | kj_min = kj_min - 1 |
---|
| 204 | ! |
---|
| 205 | icorrxt = 0 |
---|
| 206 | icorrxu = -1 |
---|
| 207 | icorrxv = 0 |
---|
| 208 | icorrxf = -1 |
---|
| 209 | ! |
---|
| 210 | icorryt = 0 |
---|
| 211 | icorryu = 0 |
---|
| 212 | icorryv = -1 |
---|
| 213 | icorryf = -1 |
---|
| 214 | ! |
---|
| 215 | IF(isym_x.EQ.1) THEN ! no bipole |
---|
| 216 | ki_min = itmp1 |
---|
| 217 | IF(llq)THEN |
---|
| 218 | icorrxt = 0 |
---|
| 219 | icorrxu = -1 + npivot |
---|
| 220 | icorrxv = 0 |
---|
| 221 | ! |
---|
| 222 | icorryt = 0 |
---|
| 223 | icorryu = 0 |
---|
| 224 | icorryv = -1 + npivot |
---|
| 225 | ! |
---|
| 226 | llq = .FALSE. |
---|
| 227 | ENDIF |
---|
| 228 | ELSEIF(isym_x.EQ.2) THEN ! no bipole |
---|
| 229 | ki_min = itmp2 |
---|
| 230 | ELSEIF(isym_x.EQ.3) THEN ! canadian bipole |
---|
| 231 | ki_min = itmp3 |
---|
| 232 | ELSEIF(isym_x.EQ.4) THEN ! canadian bipole |
---|
| 233 | ki_min = itmp4 |
---|
| 234 | IF(llq)THEN |
---|
| 235 | icorrxt = 0 |
---|
| 236 | icorrxu = -1 + npivot |
---|
| 237 | icorrxv = 0 |
---|
| 238 | ! |
---|
| 239 | icorryt = 0 |
---|
| 240 | icorryu = 0 |
---|
| 241 | icorryv = -1 + npivot |
---|
| 242 | ! |
---|
| 243 | llq = .FALSE. |
---|
| 244 | ENDIF |
---|
| 245 | ELSEIF(isym_x.EQ.5) THEN ! asian bipole |
---|
| 246 | ki_min = itmp5 |
---|
| 247 | ELSEIF(isym_x.EQ.6) THEN ! asian bipole |
---|
| 248 | ki_min = itmp6 |
---|
| 249 | ELSEIF(isym_x.EQ.7) THEN ! all around the earth (2 bipoles) |
---|
| 250 | ki_min = itmp7 |
---|
| 251 | ENDIF |
---|
| 252 | ! |
---|
| 253 | ENDIF |
---|
| 254 | ! |
---|
| 255 | ELSEIF(nglobal) THEN |
---|
| 256 | kj_min = kj_min + 1 |
---|
| 257 | ki_min = 1 |
---|
| 258 | ENDIF |
---|
| 259 | ENDDO |
---|
| 260 | ! |
---|
| 261 | WRITE(*,*) '' |
---|
| 262 | WRITE(*,*) ' ### END SUBROUTINE write_mixed_grid ### ' |
---|
| 263 | WRITE(*,*) '' |
---|
| 264 | ! |
---|
| 265 | END SUBROUTINE |
---|
| 266 | ! |
---|
| 267 | END MODULE |
---|