Changeset 5930 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2015-11-26T17:07:10+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r5656 r5930 22 22 USE oce 23 23 USE dom_oce 24 USE sol_oce25 24 USE agrif_oce 26 25 USE phycst … … 29 28 USE lib_mpp 30 29 USE wrk_nemo 31 USE dynspg_oce32 30 USE zdf_oce 33 31 … … 38 36 39 37 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 40 PUBLIC interpun, interpvn , interpun2d, interpvn2d38 PUBLIC interpun, interpvn 41 39 PUBLIC interptsn, interpsshn 42 40 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b … … 80 78 !! 81 79 INTEGER :: ji,jj,jk, j1,j2, i1,i2 82 REAL(wp) :: timeref 83 REAL(wp) :: z2dt, znugdt 84 REAL(wp) :: zrhox, zrhoy 85 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 80 REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb 86 81 !!---------------------------------------------------------------------- 87 82 88 83 IF( Agrif_Root() ) RETURN 89 84 90 CALL wrk_alloc( jpi, jpj, spgv1, spgu1)85 CALL wrk_alloc( jpi, jpj, zub, zvb ) 91 86 92 87 Agrif_SpecialValue=0. … … 96 91 CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 97 92 98 #if defined key_dynspg_flt99 CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d)100 CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d)101 #endif102 103 93 Agrif_UseSpecialValue = .FALSE. 104 105 zrhox = Agrif_Rhox() 106 zrhoy = Agrif_Rhoy() 107 108 timeref = 1. 109 ! time step: leap-frog 110 z2dt = 2. * rdt 111 ! time step: Euler if restart from rest 112 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 113 ! coefficients 114 znugdt = grav * z2dt 115 94 116 95 ! prevent smoothing in ghost cells 117 96 i1=1 … … 126 105 127 106 IF((nbondi == -1).OR.(nbondi == 2)) THEN 128 #if defined key_dynspg_flt 129 DO jk=1,jpkm1 107 108 ! Smoothing 109 ! --------- 110 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 111 ua_b(2,:)=0._wp 112 DO jk=1,jpkm1 113 DO jj=1,jpj 114 ua_b(2,jj) = ua_b(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 115 END DO 116 END DO 117 DO jj=1,jpj 118 ua_b(2,jj) = ua_b(2,jj) * hur_a(2,jj) 119 END DO 120 ENDIF 121 122 DO jk=1,jpkm1 ! Smooth 130 123 DO jj=j1,j2 131 ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)132 END DO133 END DO134 135 spgu(2,:)=0. 136 124 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 125 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 126 END DO 127 END DO 128 129 zub(2,:)=0._wp ! Correct transport 137 130 DO jk=1,jpkm1 138 131 DO jj=1,jpj 139 spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 140 END DO 141 END DO 142 132 zub(2,jj) = zub(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 133 END DO 134 END DO 143 135 DO jj=1,jpj 144 IF (umask(2,jj,1).NE.0.) THEN 145 spgu(2,jj)=spgu(2,jj)/hu(2,jj) 146 ENDIF 147 END DO 148 #else 149 spgu(2,:) = ua_b(2,:) 150 #endif 151 152 DO jk=1,jpkm1 136 zub(2,jj) = zub(2,jj) * hur_a(2,jj) 137 END DO 138 139 DO jk=1,jpkm1 140 DO jj=1,jpj 141 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 142 END DO 143 END DO 144 145 ! Set tangential velocities to time splitting estimate 146 !----------------------------------------------------- 147 IF ( ln_dynspg_ts) THEN 148 zvb(2,:)=0._wp 149 DO jk=1,jpkm1 150 DO jj=1,jpj 151 zvb(2,jj) = zvb(2,jj) + fse3v_a(2,jj,jk) * va(2,jj,jk) 152 END DO 153 END DO 154 DO jj=1,jpj 155 zvb(2,jj) = zvb(2,jj) * hvr_a(2,jj) 156 END DO 157 DO jk=1,jpkm1 158 DO jj=1,jpj 159 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj))*vmask(2,jj,jk) 160 END DO 161 END DO 162 ENDIF 163 164 ! Mask domain edges: 165 !------------------- 166 DO jk=1,jpkm1 167 DO jj=1,jpj 168 ua(1,jj,jk) = 0._wp 169 va(1,jj,jk) = 0._wp 170 END DO 171 END DO 172 173 ENDIF 174 175 IF((nbondi == 1).OR.(nbondi == 2)) THEN 176 177 ! Smoothing 178 ! --------- 179 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 180 ua_b(nlci-2,:)=0._wp 181 DO jk=1,jpkm1 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 184 END DO 185 END DO 186 DO jj=1,jpj 187 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * hur_a(nlci-2,jj) 188 END DO 189 ENDIF 190 191 DO jk=1,jpkm1 ! Smooth 153 192 DO jj=j1,j2 154 ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 155 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 156 END DO 157 END DO 158 159 spgu1(2,:)=0. 160 193 ua(nlci-2,jj,jk) = 0.25_wp*(ua(nlci-3,jj,jk)+2._wp*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 194 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 195 END DO 196 END DO 197 198 zub(nlci-2,:)=0._wp ! Correct transport 161 199 DO jk=1,jpkm1 162 200 DO jj=1,jpj 163 spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 164 END DO 165 END DO 166 201 zub(nlci-2,jj) = zub(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 202 END DO 203 END DO 167 204 DO jj=1,jpj 168 IF (umask(2,jj,1).NE.0.) THEN 169 spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 170 ENDIF 171 END DO 172 173 DO jk=1,jpkm1 174 DO jj=j1,j2 175 ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 176 END DO 177 END DO 178 179 #if defined key_dynspg_ts 205 zub(nlci-2,jj) = zub(nlci-2,jj) * hur_a(nlci-2,jj) 206 END DO 207 208 DO jk=1,jpkm1 209 DO jj=1,jpj 210 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+ua_b(nlci-2,jj)-zub(nlci-2,jj))*umask(nlci-2,jj,jk) 211 END DO 212 END DO 213 180 214 ! Set tangential velocities to time splitting estimate 181 spgv1(2,:)=0. 182 DO jk=1,jpkm1 215 !----------------------------------------------------- 216 IF ( ln_dynspg_ts) THEN 217 zvb(nlci-1,:)=0._wp 218 DO jk=1,jpkm1 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) + fse3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 221 END DO 222 END DO 183 223 DO jj=1,jpj 184 spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk) 185 END DO 186 END DO 187 DO jj=1,jpj 188 spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 189 END DO 224 zvb(nlci-1,jj) = zvb(nlci-1,jj) * hvr_a(nlci-1,jj) 225 END DO 226 DO jk=1,jpkm1 227 DO jj=1,jpj 228 va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-zvb(nlci-1,jj))*vmask(nlci-1,jj,jk) 229 END DO 230 END DO 231 ENDIF 232 233 ! Mask domain edges: 234 !------------------- 190 235 DO jk=1,jpkm1 191 236 DO jj=1,jpj 192 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk) 193 END DO 194 END DO 195 #endif 196 197 ENDIF 198 199 IF((nbondi == 1).OR.(nbondi == 2)) THEN 200 #if defined key_dynspg_flt 201 DO jk=1,jpkm1 202 DO jj=j1,j2 203 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 204 END DO 205 END DO 206 spgu(nlci-2,:)=0. 207 DO jk=1,jpkm1 208 DO jj=1,jpj 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 ENDDO 211 ENDDO 212 DO jj=1,jpj 213 IF (umask(nlci-2,jj,1).NE.0.) THEN 214 spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 215 ENDIF 216 END DO 217 #else 218 spgu(nlci-2,:) = ua_b(nlci-2,:) 219 #endif 220 DO jk=1,jpkm1 221 DO jj=j1,j2 222 ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 223 224 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 225 226 END DO 227 END DO 228 spgu1(nlci-2,:)=0. 229 DO jk=1,jpkm1 230 DO jj=1,jpj 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 END DO 233 END DO 234 DO jj=1,jpj 235 IF (umask(nlci-2,jj,1).NE.0.) THEN 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 237 ENDIF 238 END DO 239 DO jk=1,jpkm1 240 DO jj=j1,j2 241 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 242 END DO 243 END DO 244 245 #if defined key_dynspg_ts 237 ua(nlci-1,jj,jk) = 0._wp 238 va(nlci ,jj,jk) = 0._wp 239 END DO 240 END DO 241 242 ENDIF 243 244 IF((nbondj == -1).OR.(nbondj == 2)) THEN 245 246 ! Smoothing 247 ! --------- 248 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 249 va_b(:,2)=0._wp 250 DO jk=1,jpkm1 251 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) 253 END DO 254 END DO 255 DO ji=1,jpi 256 va_b(ji,2) = va_b(ji,2) * hvr_a(ji,2) 257 END DO 258 ENDIF 259 260 DO jk=1,jpkm1 ! Smooth 261 DO ji=i1,i2 262 va(ji,2,jk)=0.25_wp*(va(ji,1,jk)+2._wp*va(ji,2,jk)+va(ji,3,jk)) 263 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 264 END DO 265 END DO 266 267 zvb(:,2)=0._wp ! Correct transport 268 DO jk=1,jpkm1 269 DO ji=1,jpi 270 zvb(ji,2) = zvb(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 271 END DO 272 END DO 273 DO ji=1,jpi 274 zvb(ji,2) = zvb(ji,2) * hvr_a(ji,2) 275 END DO 276 DO jk=1,jpkm1 277 DO ji=1,jpi 278 va(ji,2,jk) = (va(ji,2,jk)+va_b(ji,2)-zvb(ji,2))*vmask(ji,2,jk) 279 END DO 280 END DO 281 246 282 ! Set tangential velocities to time splitting estimate 247 spgv1(nlci-1,:)=0._wp 248 DO jk=1,jpkm1 249 DO jj=1,jpj 250 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 251 END DO 252 END DO 253 254 DO jj=1,jpj 255 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj) 256 END DO 257 258 DO jk=1,jpkm1 259 DO jj=1,jpj 260 va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk) 261 END DO 262 END DO 263 #endif 264 265 ENDIF 266 267 IF((nbondj == -1).OR.(nbondj == 2)) THEN 268 269 #if defined key_dynspg_flt 270 DO jk=1,jpkm1 283 !----------------------------------------------------- 284 IF ( ln_dynspg_ts ) THEN 285 zub(:,2)=0._wp 286 DO jk=1,jpkm1 287 DO ji=1,jpi 288 zub(ji,2) = zub(ji,2) + fse3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 289 END DO 290 END DO 271 291 DO ji=1,jpi 272 va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk) 273 END DO 274 END DO 275 276 spgv(:,2)=0. 277 292 zub(ji,2) = zub(ji,2) * hur_a(ji,2) 293 END DO 294 295 DO jk=1,jpkm1 296 DO ji=1,jpi 297 ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-zub(ji,2))*umask(ji,2,jk) 298 END DO 299 END DO 300 ENDIF 301 302 ! Mask domain edges: 303 !------------------- 278 304 DO jk=1,jpkm1 279 305 DO ji=1,jpi 280 spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 281 END DO 282 END DO 283 306 ua(ji,1,jk) = 0._wp 307 va(ji,1,jk) = 0._wp 308 END DO 309 END DO 310 311 ENDIF 312 313 IF((nbondj == 1).OR.(nbondj == 2)) THEN 314 ! Smoothing 315 ! --------- 316 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 317 va_b(:,nlcj-2)=0._wp 318 DO jk=1,jpkm1 319 DO ji=1,jpi 320 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 321 END DO 322 END DO 323 DO ji=1,jpi 324 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * hvr_a(ji,nlcj-2) 325 END DO 326 ENDIF 327 328 DO jk=1,jpkm1 ! Smooth 329 DO ji=i1,i2 330 va(ji,nlcj-2,jk)=0.25_wp*(va(ji,nlcj-3,jk)+2._wp*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 331 va(ji,nlcj-2,jk)=va(ji,nlcj-2,jk)*vmask(ji,nlcj-2,jk) 332 END DO 333 END DO 334 335 zvb(:,nlcj-2)=0._wp ! Correct transport 336 DO jk=1,jpkm1 337 DO ji=1,jpi 338 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 339 END DO 340 END DO 284 341 DO ji=1,jpi 285 IF (vmask(ji,2,1).NE.0.) THEN 286 spgv(ji,2)=spgv(ji,2)/hv(ji,2) 287 ENDIF 288 END DO 289 #else 290 spgv(:,2)=va_b(:,2) 291 #endif 292 293 DO jk=1,jpkm1 294 DO ji=i1,i2 295 va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 296 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 297 END DO 298 END DO 299 300 spgv1(:,2)=0. 301 342 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * hvr_a(ji,nlcj-2) 343 END DO 302 344 DO jk=1,jpkm1 303 345 DO ji=1,jpi 304 spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 305 END DO 306 END DO 307 308 DO ji=1,jpi 309 IF (vmask(ji,2,1).NE.0.) THEN 310 spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 311 ENDIF 312 END DO 313 314 DO jk=1,jpkm1 346 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+va_b(ji,nlcj-2)-zvb(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 347 END DO 348 END DO 349 350 ! Set tangential velocities to time splitting estimate 351 !----------------------------------------------------- 352 IF ( ln_dynspg_ts ) THEN 353 zub(:,nlcj-1)=0._wp 354 DO jk=1,jpkm1 355 DO ji=1,jpi 356 zub(ji,nlcj-1) = zub(ji,nlcj-1) + fse3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 357 END DO 358 END DO 315 359 DO ji=1,jpi 316 va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 317 END DO 318 END DO 319 320 #if defined key_dynspg_ts 321 ! Set tangential velocities to time splitting estimate 322 spgu1(:,2)=0._wp 360 zub(ji,nlcj-1) = zub(ji,nlcj-1) * hur_a(ji,nlcj-1) 361 END DO 362 363 DO jk=1,jpkm1 364 DO ji=1,jpi 365 ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-zub(ji,nlcj-1))*umask(ji,nlcj-1,jk) 366 END DO 367 END DO 368 ENDIF 369 370 ! Mask domain edges: 371 !------------------- 323 372 DO jk=1,jpkm1 324 373 DO ji=1,jpi 325 spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 326 END DO 327 END DO 328 329 DO ji=1,jpi 330 spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2) 331 END DO 332 333 DO jk=1,jpkm1 334 DO ji=1,jpi 335 ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk) 336 END DO 337 END DO 338 #endif 339 ENDIF 340 341 IF((nbondj == 1).OR.(nbondj == 2)) THEN 342 343 #if defined key_dynspg_flt 344 DO jk=1,jpkm1 345 DO ji=1,jpi 346 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 347 END DO 348 END DO 349 350 351 spgv(:,nlcj-2)=0. 352 353 DO jk=1,jpkm1 354 DO ji=1,jpi 355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 356 END DO 357 END DO 358 359 DO ji=1,jpi 360 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 362 ENDIF 363 END DO 364 365 #else 366 spgv(:,nlcj-2)=va_b(:,nlcj-2) 367 #endif 368 369 DO jk=1,jpkm1 370 DO ji=i1,i2 371 va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 372 va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 373 END DO 374 END DO 375 376 spgv1(:,nlcj-2)=0. 377 378 DO jk=1,jpkm1 379 DO ji=1,jpi 380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 381 END DO 382 END DO 383 384 DO ji=1,jpi 385 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 387 ENDIF 388 END DO 389 390 DO jk=1,jpkm1 391 DO ji=1,jpi 392 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 393 END DO 394 END DO 395 396 #if defined key_dynspg_ts 397 ! Set tangential velocities to time splitting estimate 398 spgu1(:,nlcj-1)=0._wp 399 DO jk=1,jpkm1 400 DO ji=1,jpi 401 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 402 END DO 403 END DO 404 405 DO ji=1,jpi 406 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1) 407 END DO 408 409 DO jk=1,jpkm1 410 DO ji=1,jpi 411 ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk) 412 END DO 413 END DO 414 #endif 415 416 ENDIF 417 ! 418 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 374 ua(ji,nlcj ,jk) = 0._wp 375 va(ji,nlcj-1,jk) = 0._wp 376 END DO 377 END DO 378 379 ENDIF 380 ! 381 CALL wrk_dealloc( jpi, jpj, zub, zvb ) 419 382 ! 420 383 END SUBROUTINE Agrif_dyn … … 687 650 END DO 688 651 END DO 652 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 689 653 ENDDO 690 654 ENDIF … … 706 670 END DO 707 671 END DO 672 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 708 673 ENDDO 709 674 ENDIF … … 724 689 END DO 725 690 END DO 691 tsa(1,j1:j2,k1:k2,jn) = 0._wp 726 692 END DO 727 693 ENDIF … … 742 708 END DO 743 709 END DO 710 tsa(i1:i2,1,k1:k2,jn) = 0._wp 744 711 ENDDO 745 712 ENDIF … … 828 795 END SUBROUTINE interpun 829 796 830 831 SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)832 !!---------------------------------------------833 !! *** ROUTINE interpun ***834 !!---------------------------------------------835 !836 INTEGER, INTENT(in) :: i1,i2,j1,j2837 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab838 LOGICAL, INTENT(in) :: before839 !840 INTEGER :: ji,jj841 REAL(wp) :: ztref842 REAL(wp) :: zrhoy843 !!---------------------------------------------844 !845 ztref = 1.846 847 IF (before) THEN848 DO jj=j1,j2849 DO ji=i1,MIN(i2,nlci-1)850 ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj))851 END DO852 END DO853 ELSE854 zrhoy = Agrif_Rhoy()855 DO jj=j1,j2856 laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1)857 END DO858 ENDIF859 !860 END SUBROUTINE interpun2d861 862 863 797 SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 864 798 !!--------------------------------------------- … … 895 829 ! 896 830 END SUBROUTINE interpvn 897 898 SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before)899 !!---------------------------------------------900 !! *** ROUTINE interpvn ***901 !!---------------------------------------------902 !903 INTEGER, INTENT(in) :: i1,i2,j1,j2904 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab905 LOGICAL, INTENT(in) :: before906 !907 INTEGER :: ji,jj908 REAL(wp) :: zrhox909 REAL(wp) :: ztref910 !!---------------------------------------------911 !912 ztref = 1.913 IF (before) THEN914 !interpv entre 1 et k2 et interpv2d en jpkp1915 DO jj=j1,MIN(j2,nlcj-1)916 DO ji=i1,i2917 ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1)918 END DO919 END DO920 ELSE921 zrhox = Agrif_Rhox()922 DO ji=i1,i2923 laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2)))924 END DO925 ENDIF926 !927 END SUBROUTINE interpvn2d928 831 929 832 SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir)
Note: See TracChangeset
for help on using the changeset viewer.