[3479] | 1 | MODULE agrif_lim2_interp |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE agrif_lim2_update *** |
---|
| 4 | !! Nesting module : update surface ocean boundary condition over ice |
---|
| 5 | !! from a child grif |
---|
| 6 | !! Sea-Ice model : LIM 2.0 Sea ice model time-stepping |
---|
| 7 | !!====================================================================== |
---|
| 8 | !! History : 2.0 ! 04-2008 (F. Dupont) initial version |
---|
| 9 | !! 3.4 ! 09-2012 (R. Benshila, C. Herbaut) update and EVP |
---|
| 10 | !!---------------------------------------------------------------------- |
---|
| 11 | #if defined key_agrif && defined key_lim2 |
---|
| 12 | !!---------------------------------------------------------------------- |
---|
| 13 | !! 'key_lim2' : LIM 2.0 sea-ice model |
---|
| 14 | !! 'key_agrif' : AGRIF library |
---|
| 15 | !!---------------------------------------------------------------------- |
---|
| 16 | !! agrif_interp_lim2 : update sea-ice model on boundaries or total |
---|
| 17 | !! sea-ice area |
---|
| 18 | !! agrif_rhg_lim2_load : interpolcation of ice velocities using Agrif |
---|
| 19 | !! agrif_rhg_lim2 : sub-interpolation of ice velocities for both |
---|
| 20 | !! splitting time and sea-ice time step |
---|
| 21 | !! agrif_interp_u_ice : atomic routine to interpolate u_ice |
---|
| 22 | !! agrif_interp_u_ice : atomic routine to interpolate v_ice |
---|
| 23 | !! agrif_trp_lim2_load : interpolcation of ice properties using Agrif |
---|
| 24 | !! agrif_trp_lim2 : sub-interpolation of ice properties for |
---|
| 25 | !! sea-ice time step |
---|
| 26 | !! agrif_interp_u_ice : atomic routine to interpolate ice properties |
---|
| 27 | !!---------------------------------------------------------------------- |
---|
| 28 | USE par_oce |
---|
| 29 | USE dom_oce |
---|
| 30 | USE sbc_oce |
---|
| 31 | USE ice_2 |
---|
| 32 | USE dom_ice_2 |
---|
| 33 | USE agrif_ice |
---|
| 34 | |
---|
| 35 | IMPLICIT NONE |
---|
| 36 | PRIVATE |
---|
| 37 | |
---|
| 38 | PUBLIC agrif_rhg_lim2_load, agrif_rhg_lim2 |
---|
| 39 | PUBLIC agrif_trp_lim2_load, agrif_trp_lim2 |
---|
| 40 | PUBLIC interp_u_ice, interp_v_ice |
---|
| 41 | PUBLIC interp_adv_ice |
---|
| 42 | |
---|
| 43 | !!---------------------------------------------------------------------- |
---|
| 44 | !! NEMO/NST 3.4 , NEMO Consortium (2012) |
---|
| 45 | !! $Id$ |
---|
| 46 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
| 47 | !!---------------------------------------------------------------------- |
---|
| 48 | |
---|
| 49 | CONTAINS |
---|
| 50 | |
---|
| 51 | # if defined key_lim2_vp |
---|
| 52 | SUBROUTINE agrif_rhg_lim2_load |
---|
| 53 | !!----------------------------------------------------------------------- |
---|
| 54 | !! *** ROUTINE agrif_rhg_lim2_load *** |
---|
| 55 | !! |
---|
| 56 | !! ** Method : need a special routine for dealing with exchanging data |
---|
| 57 | !! between the child and parent grid during ice step |
---|
| 58 | !! |
---|
| 59 | !!----------------------------------------------------------------------- |
---|
| 60 | ! |
---|
| 61 | IF (Agrif_Root()) RETURN |
---|
| 62 | |
---|
| 63 | Agrif_SpecialValue=0. |
---|
| 64 | Agrif_UseSpecialValue = .FALSE. |
---|
| 65 | u_ice_nst(:,:) = 0. |
---|
| 66 | v_ice_nst(:,:) = 0. |
---|
| 67 | CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) |
---|
| 68 | CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) |
---|
| 69 | Agrif_SpecialValue=0. |
---|
| 70 | Agrif_UseSpecialValue = .FALSE. |
---|
| 71 | ! |
---|
| 72 | END SUBROUTINE agrif_rhg_lim2_load |
---|
| 73 | |
---|
| 74 | |
---|
| 75 | SUBROUTINE agrif_rhg_lim2(pu_n,pv_n) |
---|
| 76 | !!----------------------------------------------------------------------- |
---|
| 77 | !! *** ROUTINE agrif_rhg_lim2 *** |
---|
| 78 | !! |
---|
| 79 | !! ** Method : we feel the boundaries with values stored above |
---|
| 80 | !!----------------------------------------------------------------------- |
---|
| 81 | REAL(wp), DIMENSION(jpi,0:jpj+1), INTENT(inout) :: pu_n, pv_n |
---|
| 82 | !! |
---|
| 83 | REAL(wp) :: zrhox, zrhoy |
---|
| 84 | INTEGER :: ji,jj |
---|
| 85 | !!----------------------------------------------------------------------- |
---|
| 86 | ! |
---|
| 87 | IF (Agrif_Root()) RETURN |
---|
| 88 | |
---|
| 89 | zrhox = Agrif_Rhox() |
---|
| 90 | zrhoy = Agrif_Rhoy() |
---|
| 91 | |
---|
| 92 | IF((nbondi == -1).OR.(nbondi == 2)) THEN |
---|
| 93 | DO jj=2,jpj |
---|
| 94 | pu_n(3,jj) = u_ice_nst(3,jj)/(zrhoy*e2f(2,jj-1))*tmu(3,jj) |
---|
| 95 | END DO |
---|
| 96 | DO jj=2,jpj |
---|
| 97 | pv_n(3,jj) = v_ice_nst(3,jj)/(zrhox*e1f(2,jj-1))*tmu(3,jj) |
---|
| 98 | END DO |
---|
| 99 | ENDIF |
---|
| 100 | |
---|
| 101 | IF((nbondi == 1).OR.(nbondi == 2)) THEN |
---|
| 102 | DO jj=2,jpj |
---|
| 103 | pu_n(nlci-1,jj) = u_ice_nst(nlci-1,jj)/(zrhoy*e2f(nlci-2,jj-1))*tmu(nlci-1,jj) |
---|
| 104 | END DO |
---|
| 105 | DO jj=2,jpj |
---|
| 106 | pv_n(nlci-1,jj) = v_ice_nst(nlci-1,jj)/(zrhox*e1f(nlci-2,jj-1))*tmu(nlci-1,jj) |
---|
| 107 | END DO |
---|
| 108 | ENDIF |
---|
| 109 | |
---|
| 110 | IF((nbondj == -1).OR.(nbondj == 2)) THEN |
---|
| 111 | DO ji=2,jpi |
---|
| 112 | pv_n(ji,3) = v_ice_nst(ji,3)/(zrhox*e1f(ji-1,2))*tmu(ji,3) |
---|
| 113 | END DO |
---|
| 114 | DO ji=2,jpi |
---|
| 115 | pu_n(ji,3) = u_ice_nst(ji,3)/(zrhoy*e2f(ji-1,2))*tmu(ji,3) |
---|
| 116 | END DO |
---|
| 117 | ENDIF |
---|
| 118 | |
---|
| 119 | IF((nbondj == 1).OR.(nbondj == 2)) THEN |
---|
| 120 | DO ji=2,jpi |
---|
| 121 | pv_n(ji,nlcj-1) = v_ice_nst(ji,nlcj-1)/(zrhox*e1f(ji-1,nlcj-2))*tmu(ji,nlcj-1) |
---|
| 122 | END DO |
---|
| 123 | DO ji=2,jpi |
---|
| 124 | pu_n(ji,nlcj-1) = u_ice_nst(ji,nlcj-1)/(zrhoy*e2f(ji-1,nlcj-2))*tmu(ji,nlcj-1) |
---|
| 125 | END DO |
---|
| 126 | ENDIF |
---|
| 127 | ! |
---|
| 128 | END SUBROUTINE agrif_rhg_lim2 |
---|
| 129 | |
---|
| 130 | #else |
---|
| 131 | SUBROUTINE agrif_rhg_lim2_load |
---|
| 132 | !!----------------------------------------------------------------------- |
---|
| 133 | !! *** ROUTINE agrif_rhg_lim2_load *** |
---|
| 134 | !! |
---|
| 135 | !! ** Method : need a special routine for dealing with exchanging data |
---|
| 136 | !! between the child and parent grid during ice step |
---|
| 137 | !! we interpolate and store the boundary if needed, ie if |
---|
| 138 | !! we are in inside a new parent ice time step |
---|
| 139 | !!----------------------------------------------------------------------- |
---|
| 140 | REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice |
---|
| 141 | INTEGER :: ji,jj |
---|
| 142 | REAL(wp) :: zrhox, zrhoy |
---|
| 143 | !!----------------------------------------------------------------------- |
---|
| 144 | ! |
---|
| 145 | IF (Agrif_Root()) RETURN |
---|
| 146 | |
---|
| 147 | IF( lim_nbstep == 1. ) THEN |
---|
| 148 | ! |
---|
| 149 | ! switch old values by hand |
---|
| 150 | u_ice_oe(:,:,1) = u_ice_oe(:,:,2) |
---|
| 151 | v_ice_oe(:,:,1) = v_ice_oe(:,:,2) |
---|
| 152 | u_ice_sn(:,:,1) = u_ice_sn(:,:,2) |
---|
| 153 | v_ice_sn(:,:,1) = v_ice_sn(:,:,2) |
---|
| 154 | ! interpolation of boundaries (called weight prevents AGRIF interpolation) |
---|
| 155 | Agrif_SpecialValue=-9999. |
---|
| 156 | Agrif_UseSpecialValue = .TRUE. |
---|
| 157 | zuice = 0. |
---|
| 158 | zvice = 0. |
---|
| 159 | CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) |
---|
| 160 | CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) |
---|
| 161 | Agrif_SpecialValue=0. |
---|
| 162 | Agrif_UseSpecialValue = .FALSE. |
---|
| 163 | ! |
---|
| 164 | zrhox = agrif_rhox() ; zrhoy = agrif_rhoy() |
---|
| 165 | zuice(:,:) = zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) |
---|
| 166 | zvice(:,:) = zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) |
---|
| 167 | ! fill boundaries |
---|
| 168 | DO jj = 1, jpj |
---|
| 169 | DO ji = 1, 2 |
---|
| 170 | u_ice_oe(ji, jj,2) = zuice(ji ,jj) |
---|
| 171 | u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj) |
---|
| 172 | END DO |
---|
| 173 | END DO |
---|
| 174 | DO jj = 1, jpj |
---|
| 175 | v_ice_oe(2,jj,2) = zvice(2 ,jj) |
---|
| 176 | v_ice_oe(4,jj,2) = zvice(nlci-1,jj) |
---|
| 177 | END DO |
---|
| 178 | DO ji = 1, jpi |
---|
| 179 | u_ice_sn(ji,2,2) = zuice(ji,2 ) |
---|
| 180 | u_ice_sn(ji,4,2) = zuice(ji,nlcj-1) |
---|
| 181 | END DO |
---|
| 182 | DO jj = 1, 2 |
---|
| 183 | DO ji = 1, jpi |
---|
| 184 | v_ice_sn(ji,jj ,2) = zvice(ji,jj ) |
---|
| 185 | v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3) |
---|
| 186 | END DO |
---|
| 187 | END DO |
---|
| 188 | ! |
---|
| 189 | ENDIF |
---|
| 190 | ! |
---|
| 191 | END SUBROUTINE agrif_rhg_lim2_load |
---|
| 192 | |
---|
| 193 | |
---|
| 194 | SUBROUTINE agrif_rhg_lim2( kiter, kitermax, cd_type) |
---|
| 195 | !!----------------------------------------------------------------------- |
---|
| 196 | !! *** ROUTINE agrif_rhg_lim2 *** |
---|
| 197 | !! |
---|
| 198 | !! ** Method : simple call to atomic routines using stored values to |
---|
| 199 | !! fill the boundaries depending of the position of the point and |
---|
| 200 | !! computing factor for time interpolation |
---|
| 201 | !!----------------------------------------------------------------------- |
---|
| 202 | INTEGER, INTENT(in) :: kiter, kitermax |
---|
| 203 | CHARACTER(len=1), INTENT( in ) :: cd_type |
---|
| 204 | !! |
---|
| 205 | REAL(wp) :: zalpha, zbeta |
---|
| 206 | !!----------------------------------------------------------------------- |
---|
| 207 | ! |
---|
| 208 | IF (Agrif_Root()) RETURN |
---|
| 209 | zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) |
---|
| 210 | zbeta = REAL(kiter,wp) / kitermax |
---|
| 211 | zbeta = zalpha * zbeta |
---|
| 212 | SELECT CASE(cd_type) |
---|
| 213 | CASE('U') |
---|
| 214 | CALL ParcoursU( zbeta ) |
---|
| 215 | CASE('V') |
---|
| 216 | CALL ParcoursV( zbeta ) |
---|
| 217 | END SELECT |
---|
| 218 | ! |
---|
| 219 | END SUBROUTINE agrif_rhg_lim2 |
---|
| 220 | |
---|
| 221 | |
---|
| 222 | SUBROUTINE ParcoursU( pbeta ) |
---|
| 223 | !!----------------------------------------------------------------------- |
---|
| 224 | !! *** ROUTINE parcoursU *** |
---|
| 225 | !! |
---|
| 226 | !! ** Method : time and spatial interpolation for U-point using values |
---|
| 227 | !! interpolated from the coarse grid and inside dvalues |
---|
| 228 | !!----------------------------------------------------------------------- |
---|
| 229 | REAL(wp), INTENT(in) :: pbeta |
---|
| 230 | !! |
---|
| 231 | INTEGER :: ji, jj |
---|
| 232 | !!----------------------------------------------------------------------- |
---|
| 233 | ! |
---|
| 234 | IF((nbondi == -1).OR.(nbondi == 2)) THEN |
---|
| 235 | DO jj=1,jpj |
---|
| 236 | DO ji=1,2 |
---|
| 237 | u_ice(ji,jj) = (1-pbeta) * u_ice_oe(ji,jj,1) + pbeta * u_ice_oe(ji,jj,2) |
---|
| 238 | END DO |
---|
| 239 | END DO |
---|
| 240 | DO jj=1,jpj |
---|
| 241 | u_ice(2,jj) = 0.25*(u_ice(1,jj)+2.*u_ice(2,jj)+u_ice(3,jj)) |
---|
| 242 | u_ice(2,jj) = u_ice(2,jj) * umask(2,jj,1) |
---|
| 243 | END DO |
---|
| 244 | ENDIF |
---|
| 245 | |
---|
| 246 | IF((nbondi == 1).OR.(nbondi == 2)) THEN |
---|
| 247 | DO jj=1,jpj |
---|
| 248 | DO ji=1,2 |
---|
| 249 | u_ice(nlci+ji-3,jj) = (1-pbeta) * u_ice_oe(ji+2,jj,1) + pbeta * u_ice_oe(ji+2,jj,2) |
---|
| 250 | END DO |
---|
| 251 | END DO |
---|
| 252 | DO jj=1,jpj |
---|
| 253 | u_ice(nlci-2,jj) = 0.25*(u_ice(nlci-3,jj)+2.*u_ice(nlci-2,jj)+u_ice(nlci-1,jj)) |
---|
| 254 | u_ice(nlci-2,jj) = u_ice(nlci-2,jj) * umask(nlci-2,jj,1) |
---|
| 255 | END DO |
---|
| 256 | ENDIF |
---|
| 257 | |
---|
| 258 | IF((nbondj == -1).OR.(nbondj == 2)) THEN |
---|
| 259 | DO ji=1,jpi |
---|
| 260 | u_ice(ji,2) = (1-pbeta) * u_ice_sn(ji,2,1) + pbeta * u_ice_sn(ji,2,2) |
---|
| 261 | u_ice(ji,2) = u_ice(ji,2)*umask(ji,2,1) |
---|
| 262 | END DO |
---|
| 263 | ENDIF |
---|
| 264 | |
---|
| 265 | IF((nbondj == 1).OR.(nbondj == 2)) THEN |
---|
| 266 | DO ji=1,jpi |
---|
| 267 | u_ice(ji,nlcj-1) = (1-pbeta) * u_ice_sn(ji,4,1) + pbeta * u_ice_sn(ji,4,2) |
---|
| 268 | u_ice(ji,nlcj-1) = u_ice(ji,nlcj-1)*umask(ji,nlcj-1,1) |
---|
| 269 | END DO |
---|
| 270 | ENDIF |
---|
| 271 | ! |
---|
| 272 | END SUBROUTINE ParcoursU |
---|
| 273 | |
---|
| 274 | |
---|
| 275 | SUBROUTINE ParcoursV( pbeta ) |
---|
| 276 | !!----------------------------------------------------------------------- |
---|
| 277 | !! *** ROUTINE parcoursV *** |
---|
| 278 | !! |
---|
| 279 | !! ** Method : time and spatial interpolation for V-point using values |
---|
| 280 | !! interpolated from the coarse grid and inside dvalues |
---|
| 281 | !!----------------------------------------------------------------------- |
---|
| 282 | REAL(wp), INTENT(in) :: pbeta |
---|
| 283 | !! |
---|
| 284 | INTEGER :: ji, jj |
---|
| 285 | !!----------------------------------------------------------------------- |
---|
| 286 | ! |
---|
| 287 | IF((nbondi == -1).OR.(nbondi == 2)) THEN |
---|
| 288 | DO jj=1,jpj |
---|
| 289 | v_ice(2,jj) = (1-pbeta) * v_ice_oe(2,jj,1) + pbeta * v_ice_oe(2,jj,2) |
---|
| 290 | v_ice(2,jj) = v_ice(2,jj) * vmask(2,jj,1) |
---|
| 291 | END DO |
---|
| 292 | ENDIF |
---|
| 293 | |
---|
| 294 | IF((nbondi == 1).OR.(nbondi == 2)) THEN |
---|
| 295 | DO jj=1,jpj |
---|
| 296 | v_ice(nlci-1,jj) = (1-pbeta) * v_ice_oe(4,jj,1) + pbeta * v_ice_oe(4,jj,2) |
---|
| 297 | v_ice(nlci-1,jj) = v_ice(nlci-1,jj)*vmask(nlci-1,jj,1) |
---|
| 298 | END DO |
---|
| 299 | ENDIF |
---|
| 300 | |
---|
| 301 | IF((nbondj == -1).OR.(nbondj == 2)) THEN |
---|
| 302 | DO jj=1,2 |
---|
| 303 | DO ji=1,jpi |
---|
| 304 | v_ice(ji,jj) = (1-pbeta) * v_ice_sn(ji,jj,1) + pbeta * v_ice_sn(ji,jj,2) |
---|
| 305 | END DO |
---|
| 306 | END DO |
---|
| 307 | DO ji=1,jpi |
---|
| 308 | v_ice(ji,2)=0.25*(v_ice(ji,1)+2.*v_ice(ji,2)+v_ice(ji,3)) |
---|
| 309 | v_ice(ji,2)=v_ice(ji,2)*vmask(ji,2,1) |
---|
| 310 | END DO |
---|
| 311 | ENDIF |
---|
| 312 | |
---|
| 313 | IF((nbondj == 1).OR.(nbondj == 2)) THEN |
---|
| 314 | DO jj=1,2 |
---|
| 315 | DO ji=1,jpi |
---|
| 316 | v_ice(ji,nlcj+jj-3) = (1-pbeta) * v_ice_sn(ji,jj+2,1) + pbeta * v_ice_sn(ji,jj+2,2) |
---|
| 317 | END DO |
---|
| 318 | END DO |
---|
| 319 | DO ji=1,jpi |
---|
| 320 | v_ice(ji,nlcj-2)=0.25*(v_ice(ji,nlcj-3)+2.*v_ice(ji,nlcj-2)+v_ice(ji,nlcj-1)) |
---|
| 321 | v_ice(ji,nlcj-2) = v_ice(ji,nlcj-2) * vmask(ji,nlcj-2,1) |
---|
| 322 | END DO |
---|
| 323 | ENDIF |
---|
| 324 | ! |
---|
| 325 | END SUBROUTINE ParcoursV |
---|
| 326 | # endif |
---|
| 327 | SUBROUTINE agrif_trp_lim2_load |
---|
| 328 | !!----------------------------------------------------------------------- |
---|
| 329 | !! *** ROUTINE agrif_trp_lim2_load *** |
---|
| 330 | !! |
---|
| 331 | !! ** Method : need a special routine for dealing with exchanging data |
---|
| 332 | !! between the child and parent grid during ice step |
---|
| 333 | !! we interpolate and store the boundary if needed, ie if |
---|
| 334 | !! we are in inside a new parent ice time step |
---|
| 335 | !!----------------------------------------------------------------------- |
---|
| 336 | REAL(wp), DIMENSION(jpi,jpj,7) :: ztab |
---|
| 337 | INTEGER :: ji,jj,jn |
---|
| 338 | !!----------------------------------------------------------------------- |
---|
| 339 | ! |
---|
| 340 | IF (Agrif_Root()) RETURN |
---|
| 341 | IF( lim_nbstep == 1. ) THEN |
---|
| 342 | ! |
---|
| 343 | ! switch old values |
---|
| 344 | adv_ice_oe(:,:,:,1) = adv_ice_oe(:,:,:,2) |
---|
| 345 | adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) |
---|
| 346 | ! interpolation of boundaries |
---|
| 347 | ztab(:,:,:) = 0. |
---|
| 348 | Agrif_SpecialValue=-9999. |
---|
| 349 | Agrif_UseSpecialValue = .TRUE. |
---|
| 350 | CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) |
---|
| 351 | Agrif_SpecialValue=0. |
---|
| 352 | Agrif_UseSpecialValue = .FALSE. |
---|
| 353 | ! |
---|
| 354 | ! fill boundaries |
---|
| 355 | DO jn =1,7 |
---|
| 356 | DO jj = 1, jpj |
---|
| 357 | DO ji=1,2 |
---|
| 358 | adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn) |
---|
| 359 | adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) |
---|
| 360 | END DO |
---|
| 361 | END DO |
---|
| 362 | END DO |
---|
| 363 | |
---|
| 364 | Do jn =1,7 |
---|
| 365 | Do jj =1,2 |
---|
| 366 | DO ji = 1, jpi |
---|
| 367 | adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn) |
---|
| 368 | adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) |
---|
| 369 | END DO |
---|
| 370 | END DO |
---|
| 371 | END DO |
---|
| 372 | ! |
---|
| 373 | ENDIF |
---|
| 374 | ! |
---|
| 375 | END SUBROUTINE agrif_trp_lim2_load |
---|
| 376 | |
---|
| 377 | |
---|
| 378 | SUBROUTINE agrif_trp_lim2 |
---|
| 379 | !!----------------------------------------------------------------------- |
---|
| 380 | !! *** ROUTINE agrif_trp_lim2 *** |
---|
| 381 | !! |
---|
| 382 | !! ** Method : time coefficient and call to atomic routines |
---|
| 383 | !!----------------------------------------------------------------------- |
---|
| 384 | INTEGER :: ji,jj,jn |
---|
| 385 | REAL(wp) :: zalpha |
---|
| 386 | REAL(wp), DIMENSION(jpi,jpj,7) :: ztab |
---|
| 387 | !!----------------------------------------------------------------------- |
---|
| 388 | ! |
---|
| 389 | IF (Agrif_Root()) RETURN |
---|
| 390 | |
---|
| 391 | zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) |
---|
| 392 | ! |
---|
| 393 | ztab(:,:,:) = 0.e0 |
---|
| 394 | DO jn =1,7 |
---|
| 395 | DO jj =1,2 |
---|
| 396 | DO ji = 1, jpi |
---|
| 397 | ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) |
---|
| 398 | ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) |
---|
| 399 | END DO |
---|
| 400 | END DO |
---|
| 401 | END DO |
---|
| 402 | |
---|
| 403 | DO jn =1,7 |
---|
| 404 | DO jj = 1, jpj |
---|
| 405 | DO ji=1,2 |
---|
| 406 | ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) |
---|
| 407 | ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) |
---|
| 408 | END DO |
---|
| 409 | END DO |
---|
| 410 | END DO |
---|
| 411 | ! |
---|
| 412 | CALL parcoursT( ztab(:,:, 1), frld ) |
---|
| 413 | CALL parcoursT( ztab(:,:, 2), hicif ) |
---|
| 414 | CALL parcoursT( ztab(:,:, 3), hsnif ) |
---|
| 415 | CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) |
---|
| 416 | CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) |
---|
| 417 | CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) |
---|
| 418 | CALL parcoursT( ztab(:,:, 7), qstoif ) |
---|
| 419 | ! |
---|
| 420 | END SUBROUTINE agrif_trp_lim2 |
---|
| 421 | |
---|
| 422 | |
---|
| 423 | SUBROUTINE parcoursT ( pinterp, pfinal ) |
---|
| 424 | !!----------------------------------------------------------------------- |
---|
| 425 | !! *** ROUTINE parcoursT *** |
---|
| 426 | !! |
---|
| 427 | !! ** Method : fill boundaries for T points |
---|
| 428 | !!----------------------------------------------------------------------- |
---|
| 429 | REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pinterp |
---|
| 430 | REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pfinal |
---|
| 431 | !! |
---|
| 432 | REAL(wp) :: zbound, zvbord |
---|
| 433 | REAL(wp), DIMENSION(jpi,jpj) :: zui_u, zvi_v |
---|
| 434 | INTEGER :: ji, jj |
---|
| 435 | !!----------------------------------------------------------------------- |
---|
| 436 | ! |
---|
| 437 | zui_u = 0.e0 |
---|
| 438 | zvi_v = 0.e0 |
---|
| 439 | ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions. |
---|
| 440 | zbound=0. |
---|
| 441 | zvbord = 1.0 + ( 1.0 - zbound ) |
---|
| 442 | #if defined key_lim2_vp |
---|
| 443 | DO jj = 1, jpjm1 |
---|
| 444 | DO ji = 1, jpim1 |
---|
| 445 | zui_u(ji,jj) = ( u_ice(ji+1,jj ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj ) + tmu(ji+1,jj+1), zvbord ) ) |
---|
| 446 | zvi_v(ji,jj) = ( v_ice(ji ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji ,jj+1) + tmu(ji+1,jj+1), zvbord ) ) |
---|
| 447 | END DO |
---|
| 448 | END DO |
---|
| 449 | #else |
---|
| 450 | zui_u(:,:) = u_ice(:,:) |
---|
| 451 | zvi_v(:,:) = v_ice(:,:) |
---|
| 452 | #endif |
---|
| 453 | |
---|
| 454 | IF((nbondi == -1).OR.(nbondi == 2)) THEN |
---|
| 455 | DO jj=1,jpj |
---|
| 456 | ! IF (zui_u(2,jj).EQ.0.) THEN |
---|
| 457 | ! pfinal (2,jj) = pfinal (1,jj) * tms(2,jj) |
---|
| 458 | ! ELSE |
---|
| 459 | pfinal(2,jj) = 0.25* pinterp(1,jj) + 0.5 * pinterp(2,jj) + 0.25 *pfinal(3,jj) |
---|
| 460 | ! ENDIF |
---|
| 461 | END DO |
---|
| 462 | ENDIF |
---|
| 463 | |
---|
| 464 | IF((nbondj == -1).OR.(nbondj == 2)) THEN |
---|
| 465 | DO ji=1,jpi |
---|
| 466 | ! IF (zvi_v(ji,2).EQ.0.) THEN |
---|
| 467 | ! pfinal (ji,2) = pfinal (ji,1) * tms(ji,2) |
---|
| 468 | ! ELSE |
---|
| 469 | pfinal(ji,2) = 0.25* pinterp(ji,1) + 0.5 * pinterp(ji,2) + 0.25 *pfinal(ji,3) |
---|
| 470 | ! ENDIF |
---|
| 471 | END DO |
---|
| 472 | ENDIF |
---|
| 473 | |
---|
| 474 | |
---|
| 475 | IF((nbondi == 1).OR.(nbondi == 2)) THEN |
---|
| 476 | DO jj=1,jpj |
---|
| 477 | ! IF (zui_u(nlci-2,jj).EQ.0.) THEN |
---|
| 478 | ! pfinal(nlci-1,jj) = pfinal (nlci,jj) * tms(nlci-1,jj) |
---|
| 479 | ! ELSE |
---|
| 480 | pfinal(nlci-1,jj) = 0.25* pinterp(nlci,jj) + 0.5 * pinterp(nlci-1,jj) + 0.25 *pfinal(nlci-2,jj) |
---|
| 481 | ! ENDIF |
---|
| 482 | END DO |
---|
| 483 | ENDIF |
---|
| 484 | |
---|
| 485 | IF((nbondj == 1).OR.(nbondj == 2)) THEN |
---|
| 486 | DO ji=1,jpi |
---|
| 487 | ! IF (zvi_v(ji,nlcj-2).EQ.0.) THEN |
---|
| 488 | ! pfinal (ji,nlcj-1) = pfinal(ji,nlcj) * tms(ji,nlcj-1) |
---|
| 489 | ! ELSE |
---|
| 490 | pfinal(ji,nlcj-1) = 0.25* pinterp(ji,nlcj) + 0.5 * pinterp(ji,nlcj-1) + 0.25 *pfinal(ji,nlcj-2) |
---|
| 491 | ! ENDIF |
---|
| 492 | END DO |
---|
| 493 | ENDIF |
---|
| 494 | |
---|
| 495 | |
---|
| 496 | pfinal (:,:) = pfinal (:,:) * tms(:,:) |
---|
| 497 | ! |
---|
| 498 | END SUBROUTINE parcoursT |
---|
| 499 | |
---|
| 500 | |
---|
| 501 | SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 ) |
---|
| 502 | !!----------------------------------------------------------------------- |
---|
| 503 | !! *** ROUTINE interp_u_ice *** |
---|
| 504 | !!----------------------------------------------------------------------- |
---|
| 505 | INTEGER, INTENT(in) :: i1, i2, j1, j2 |
---|
| 506 | REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres |
---|
| 507 | !! |
---|
| 508 | INTEGER :: ji,jj |
---|
| 509 | !!----------------------------------------------------------------------- |
---|
| 510 | ! |
---|
| 511 | #if defined key_lim2_vp |
---|
| 512 | DO jj=MAX(j1,2),j2 |
---|
| 513 | DO ji=MAX(i1,2),i2 |
---|
| 514 | IF( tmu(ji,jj) == 0. ) THEN |
---|
| 515 | tabres(ji,jj) = -9999. |
---|
| 516 | ELSE |
---|
| 517 | tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) |
---|
| 518 | ENDIF |
---|
| 519 | END DO |
---|
| 520 | END DO |
---|
| 521 | #else |
---|
| 522 | DO jj= j1, j2 |
---|
| 523 | DO ji= i1, i2 |
---|
| 524 | IF( umask(ji,jj,1) == 0. ) THEN |
---|
| 525 | tabres(ji,jj) = -9999. |
---|
| 526 | ELSE |
---|
| 527 | tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) |
---|
| 528 | ENDIF |
---|
| 529 | END DO |
---|
| 530 | END DO |
---|
| 531 | #endif |
---|
| 532 | END SUBROUTINE interp_u_ice |
---|
| 533 | |
---|
| 534 | |
---|
| 535 | SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 ) |
---|
| 536 | !!----------------------------------------------------------------------- |
---|
| 537 | !! *** ROUTINE interp_v_ice *** |
---|
| 538 | !!----------------------------------------------------------------------- |
---|
| 539 | INTEGER, INTENT(in) :: i1, i2, j1, j2 |
---|
| 540 | REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres |
---|
| 541 | !! |
---|
| 542 | INTEGER :: ji, jj |
---|
| 543 | !!----------------------------------------------------------------------- |
---|
| 544 | ! |
---|
| 545 | #if defined key_lim2_vp |
---|
| 546 | DO jj=MAX(j1,2),j2 |
---|
| 547 | DO ji=MAX(i1,2),i2 |
---|
| 548 | IF( tmu(ji,jj) == 0. ) THEN |
---|
| 549 | tabres(ji,jj) = -9999. |
---|
| 550 | ELSE |
---|
| 551 | tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) |
---|
| 552 | ENDIF |
---|
| 553 | END DO |
---|
| 554 | END DO |
---|
| 555 | #else |
---|
| 556 | DO jj= j1 ,j2 |
---|
| 557 | DO ji = i1, i2 |
---|
| 558 | IF( vmask(ji,jj,1) == 0. ) THEN |
---|
| 559 | tabres(ji,jj) = -9999. |
---|
| 560 | ELSE |
---|
| 561 | tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) |
---|
| 562 | ENDIF |
---|
| 563 | END DO |
---|
| 564 | END DO |
---|
| 565 | #endif |
---|
| 566 | END SUBROUTINE interp_v_ice |
---|
| 567 | |
---|
| 568 | |
---|
| 569 | SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 ) |
---|
| 570 | !!----------------------------------------------------------------------- |
---|
| 571 | !! *** ROUTINE interp_adv_ice *** |
---|
| 572 | !! |
---|
| 573 | !! ** Purpose : fill an array with ice variables |
---|
| 574 | !! to be advected |
---|
| 575 | !! put -9999 where no ice for correct extrapolation |
---|
| 576 | !!----------------------------------------------------------------------- |
---|
| 577 | INTEGER, INTENT(in) :: i1, i2, j1, j2 |
---|
| 578 | REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres |
---|
| 579 | !! |
---|
| 580 | INTEGER :: ji, jj, jk |
---|
| 581 | !!----------------------------------------------------------------------- |
---|
| 582 | ! |
---|
| 583 | DO jj=j1,j2 |
---|
| 584 | DO ji=i1,i2 |
---|
| 585 | IF( tms(ji,jj) == 0. ) THEN |
---|
| 586 | tabres(ji,jj,:) = -9999. |
---|
| 587 | ELSE |
---|
| 588 | tabres(ji,jj, 1) = frld (ji,jj) |
---|
| 589 | tabres(ji,jj, 2) = hicif (ji,jj) |
---|
| 590 | tabres(ji,jj, 3) = hsnif (ji,jj) |
---|
| 591 | tabres(ji,jj, 4) = tbif (ji,jj,1) |
---|
| 592 | tabres(ji,jj, 5) = tbif (ji,jj,2) |
---|
| 593 | tabres(ji,jj, 6) = tbif (ji,jj,3) |
---|
| 594 | tabres(ji,jj, 7) = qstoif(ji,jj) |
---|
| 595 | ENDIF |
---|
| 596 | END DO |
---|
| 597 | END DO |
---|
| 598 | ! |
---|
| 599 | END SUBROUTINE interp_adv_ice |
---|
| 600 | |
---|
| 601 | #else |
---|
| 602 | CONTAINS |
---|
| 603 | SUBROUTINE agrif_lim2_interp_empty |
---|
| 604 | !!--------------------------------------------- |
---|
| 605 | !! *** ROUTINE agrif_lim2_interp_empty *** |
---|
| 606 | !!--------------------------------------------- |
---|
| 607 | WRITE(*,*) 'agrif_lim2_interp : You should not have seen this print! error?' |
---|
| 608 | END SUBROUTINE agrif_lim2_interp_empty |
---|
| 609 | #endif |
---|
| 610 | END MODULE agrif_lim2_interp |
---|