- Timestamp:
- 2016-01-04T14:47:06+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r4491 r6204 1 #define TWO_WAY 2 1 #define TWO_WAY /* TWO WAY NESTING */ 2 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 3 3 4 MODULE agrif_opa_update 4 5 #if defined key_agrif && ! defined key_offline … … 11 12 USE wrk_nemo 12 13 USE dynspg_oce 14 USE zdf_oce ! vertical physics: ocean variables 13 15 14 16 IMPLICIT NONE 15 17 PRIVATE 16 18 17 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 18 19 INTEGER, PUBLIC :: nbcline = 020 19 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 20 # if defined key_zdftke 21 PUBLIC Agrif_Update_Tke 22 # endif 21 23 !!---------------------------------------------------------------------- 22 !! NEMO/NST 3. 3, NEMO Consortium (2010)24 !! NEMO/NST 3.6 , NEMO Consortium (2010) 23 25 !! $Id$ 24 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 27 29 CONTAINS 28 30 29 SUBROUTINE Agrif_Update_Tra( kt)31 RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 30 32 !!--------------------------------------------- 31 33 !! *** ROUTINE Agrif_Update_Tra *** 32 34 !!--------------------------------------------- 33 !! 34 INTEGER, INTENT(in) :: kt 35 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 36 37 38 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 35 ! 36 IF (Agrif_Root()) RETURN 37 ! 38 #if defined TWO_WAY 39 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed(), 'nbcline', nbcline 41 40 42 41 Agrif_UseSpecialValueInUpdate = .TRUE. 43 42 Agrif_SpecialValueFineGrid = 0. 44 43 ! 45 44 IF (MOD(nbcline,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 47 ELSE 48 CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 49 ENDIF 50 45 # if ! defined DECAL_FEEDBACK 46 CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 47 # else 48 CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 49 # endif 50 ELSE 51 # if ! defined DECAL_FEEDBACK 52 CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 53 # else 54 CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 55 # endif 56 ENDIF 57 ! 51 58 Agrif_UseSpecialValueInUpdate = .FALSE. 52 53 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 59 ! 60 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 61 CALL Agrif_ChildGrid_To_ParentGrid() 62 CALL Agrif_Update_Tra() 63 CALL Agrif_ParentGrid_To_ChildGrid() 64 ENDIF 65 ! 54 66 #endif 55 67 ! 56 68 END SUBROUTINE Agrif_Update_Tra 57 69 58 SUBROUTINE Agrif_Update_Dyn( kt)70 RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 59 71 !!--------------------------------------------- 60 72 !! *** ROUTINE Agrif_Update_Dyn *** 61 73 !!--------------------------------------------- 62 !! 63 INTEGER, INTENT(in) :: kt 64 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 66 67 68 IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 74 ! 75 IF (Agrif_Root()) RETURN 76 ! 69 77 #if defined TWO_WAY 70 CALL wrk_alloc( jpi, jpj, ztab2d ) 71 CALL wrk_alloc( jpi, jpj, jpk, ztab ) 72 78 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline 79 80 Agrif_UseSpecialValueInUpdate = .FALSE. 81 Agrif_SpecialValueFineGrid = 0. 82 ! 73 83 IF (mod(nbcline,nbclineupdate) == 0) THEN 74 CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 75 CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 76 ELSE 77 CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 78 CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV) 79 ENDIF 80 81 CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d) 82 CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d) 83 84 #if defined key_dynspg_ts 84 # if ! defined DECAL_FEEDBACK 85 CALL Agrif_Update_Variable(un_update_id,procname = updateU) 86 CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 87 # else 88 CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 89 CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 90 # endif 91 ELSE 92 # if ! defined DECAL_FEEDBACK 93 CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 94 CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV) 95 # else 96 CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 97 CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 98 # endif 99 ENDIF 100 101 # if ! defined DECAL_FEEDBACK 102 CALL Agrif_Update_Variable(e1u_id,procname = updateU2d) 103 CALL Agrif_Update_Variable(e2v_id,procname = updateV2d) 104 # else 105 CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d) 106 CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d) 107 # endif 108 109 # if defined key_dynspg_ts 85 110 IF (ln_bt_fw) THEN 86 111 ! Update time integrated transports 87 112 IF (mod(nbcline,nbclineupdate) == 0) THEN 88 CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b) 89 CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b) 113 # if ! defined DECAL_FEEDBACK 114 CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 115 CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 116 # else 117 CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 118 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 119 # endif 90 120 ELSE 91 CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b) 92 CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b) 121 # if ! defined DECAL_FEEDBACK 122 CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b) 123 CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b) 124 # else 125 CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b) 126 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 127 # endif 93 128 ENDIF 94 END IF 129 END IF 130 # endif 131 ! 132 nbcline = nbcline + 1 133 ! 134 Agrif_UseSpecialValueInUpdate = .TRUE. 135 Agrif_SpecialValueFineGrid = 0. 136 # if ! defined DECAL_FEEDBACK 137 CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 138 # else 139 CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH) 140 # endif 141 Agrif_UseSpecialValueInUpdate = .FALSE. 142 ! 95 143 #endif 96 97 nbcline = nbcline + 1 98 99 Agrif_UseSpecialValueInUpdate = .TRUE. 144 ! 145 ! Do recursive update: 146 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 147 CALL Agrif_ChildGrid_To_ParentGrid() 148 CALL Agrif_Update_Dyn() 149 CALL Agrif_ParentGrid_To_ChildGrid() 150 ENDIF 151 ! 152 END SUBROUTINE Agrif_Update_Dyn 153 154 # if defined key_zdftke 155 SUBROUTINE Agrif_Update_Tke( kt ) 156 !!--------------------------------------------- 157 !! *** ROUTINE Agrif_Update_Tke *** 158 !!--------------------------------------------- 159 !! 160 INTEGER, INTENT(in) :: kt 161 ! 162 IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 163 # if defined TWO_WAY 164 165 Agrif_UseSpecialValueInUpdate = .TRUE. 100 166 Agrif_SpecialValueFineGrid = 0. 101 CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 167 168 CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN ) 169 CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 170 CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 171 102 172 Agrif_UseSpecialValueInUpdate = .FALSE. 103 173 104 CALL wrk_dealloc( jpi, jpj, ztab2d ) 105 CALL wrk_dealloc( jpi, jpj, jpk, ztab ) 106 107 !Done in step 108 ! CALL Agrif_ChildGrid_To_ParentGrid() 109 ! CALL recompute_diags( kt ) 110 ! CALL Agrif_ParentGrid_To_ChildGrid() 111 112 #endif 113 114 END SUBROUTINE Agrif_Update_Dyn 115 116 SUBROUTINE recompute_diags( kt ) 117 !!--------------------------------------------- 118 !! *** ROUTINE recompute_diags *** 119 !!--------------------------------------------- 120 INTEGER, INTENT(in) :: kt 121 122 END SUBROUTINE recompute_diags 174 # endif 175 176 END SUBROUTINE Agrif_Update_Tke 177 # endif /* key_zdftke */ 123 178 124 179 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) … … 127 182 !!--------------------------------------------- 128 183 # include "domzgr_substitute.h90" 129 130 184 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 131 185 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 132 LOGICAL, iNTENT(in) :: before133 186 LOGICAL, INTENT(in) :: before 187 !! 134 188 INTEGER :: ji,jj,jk,jn 135 189 !!--------------------------------------------- 190 ! 136 191 IF (before) THEN 137 192 DO jn = n1,n2 … … 146 201 ELSE 147 202 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 148 ! Add asselin part203 ! Add asselin part 149 204 DO jn = n1,n2 150 205 DO jk=k1,k2 … … 153 208 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 154 209 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 155 & + atfp * ( tabres(ji,jj,jk,jn) &156 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)210 & + atfp * ( tabres(ji,jj,jk,jn) & 211 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 157 212 ENDIF 158 213 ENDDO … … 161 216 ENDDO 162 217 ENDIF 163 164 218 DO jn = n1,n2 165 219 DO jk=k1,k2 … … 174 228 END DO 175 229 ENDIF 176 230 ! 177 231 END SUBROUTINE updateTS 178 232 … … 182 236 !!--------------------------------------------- 183 237 # include "domzgr_substitute.h90" 184 238 !! 185 239 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 186 240 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 187 241 LOGICAL, INTENT(in) :: before 188 242 !! 189 243 INTEGER :: ji, jj, jk 190 244 REAL(wp) :: zrhoy 191 245 !!--------------------------------------------- 246 ! 192 247 IF (before) THEN 193 248 zrhoy = Agrif_Rhoy() … … 209 264 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 210 265 ub(ji,jj,jk) = ub(ji,jj,jk) & 211 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)266 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 212 267 ENDIF 213 268 ! … … 217 272 END DO 218 273 ENDIF 219 274 ! 220 275 END SUBROUTINE updateu 221 276 … … 225 280 !!--------------------------------------------- 226 281 # include "domzgr_substitute.h90" 227 282 !! 228 283 INTEGER :: i1,i2,j1,j2,k1,k2 229 284 INTEGER :: ji,jj,jk 230 285 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 231 286 LOGICAL :: before 232 287 !! 233 288 REAL(wp) :: zrhox 234 289 !!--------------------------------------------- 290 ! 235 291 IF (before) THEN 236 292 zrhox = Agrif_Rhox() … … 252 308 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 253 309 vb(ji,jj,jk) = vb(ji,jj,jk) & 254 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)310 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 255 311 ENDIF 256 312 ! … … 260 316 END DO 261 317 ENDIF 262 318 ! 263 319 END SUBROUTINE updatev 264 320 … … 268 324 !!--------------------------------------------- 269 325 # include "domzgr_substitute.h90" 270 326 !! 271 327 INTEGER, INTENT(in) :: i1, i2, j1, j2 272 328 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 273 329 LOGICAL, INTENT(in) :: before 274 330 !! 275 331 INTEGER :: ji, jj, jk 276 332 REAL(wp) :: zrhoy 277 333 REAL(wp) :: zcorr 278 334 !!--------------------------------------------- 335 ! 279 336 IF (before) THEN 280 337 zrhoy = Agrif_Rhoy() … … 326 383 END DO 327 384 ENDIF 328 385 ! 329 386 END SUBROUTINE updateu2d 330 387 … … 333 390 !! *** ROUTINE updatev2d *** 334 391 !!--------------------------------------------- 335 336 392 INTEGER, INTENT(in) :: i1, i2, j1, j2 337 393 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 338 394 LOGICAL, INTENT(in) :: before 339 395 !! 340 396 INTEGER :: ji, jj, jk 341 397 REAL(wp) :: zrhox 342 398 REAL(wp) :: zcorr 343 399 !!--------------------------------------------- 400 ! 344 401 IF (before) THEN 345 402 zrhox = Agrif_Rhox() … … 391 448 END DO 392 449 ENDIF 393 450 ! 394 451 END SUBROUTINE updatev2d 395 452 453 396 454 SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 397 455 !!--------------------------------------------- 398 456 !! *** ROUTINE updateSSH *** 399 457 !!--------------------------------------------- 400 # include "domzgr_substitute.h90"401 402 458 INTEGER, INTENT(in) :: i1, i2, j1, j2 403 459 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 404 460 LOGICAL, INTENT(in) :: before 405 461 !! 406 462 INTEGER :: ji, jj 407 463 !!--------------------------------------------- 464 ! 408 465 IF (before) THEN 409 466 DO jj=j1,j2 … … 413 470 END DO 414 471 ELSE 415 416 472 #if ! defined key_dynspg_ts 417 473 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 418 474 DO jj=j1,j2 419 475 DO ji=i1,i2 420 sshb(ji,jj) = sshb(ji,jj) &421 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)476 sshb(ji,jj) = sshb(ji,jj) & 477 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 422 478 END DO 423 479 END DO … … 430 486 END DO 431 487 ENDIF 432 488 ! 433 489 END SUBROUTINE updateSSH 434 490 … … 437 493 !! *** ROUTINE updateub2b *** 438 494 !!--------------------------------------------- 439 440 495 INTEGER, INTENT(in) :: i1, i2, j1, j2 441 496 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 442 497 LOGICAL, INTENT(in) :: before 443 498 !! 444 499 INTEGER :: ji, jj 445 500 REAL(wp) :: zrhoy 446 501 !!--------------------------------------------- 502 ! 447 503 IF (before) THEN 448 504 zrhoy = Agrif_Rhoy() … … 460 516 END DO 461 517 ENDIF 462 518 ! 463 519 END SUBROUTINE updateub2b 464 520 … … 467 523 !! *** ROUTINE updatevb2b *** 468 524 !!--------------------------------------------- 469 470 525 INTEGER, INTENT(in) :: i1, i2, j1, j2 471 526 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 472 527 LOGICAL, INTENT(in) :: before 473 528 !! 474 529 INTEGER :: ji, jj 475 530 REAL(wp) :: zrhox 476 531 !!--------------------------------------------- 532 ! 477 533 IF (before) THEN 478 534 zrhox = Agrif_Rhox() … … 490 546 END DO 491 547 ENDIF 492 548 ! 493 549 END SUBROUTINE updatevb2b 550 551 552 SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 553 ! currently not used 554 !!--------------------------------------------- 555 !! *** ROUTINE updateT *** 556 !!--------------------------------------------- 557 # include "domzgr_substitute.h90" 558 559 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 560 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 561 LOGICAL, iNTENT(in) :: before 562 563 INTEGER :: ji,jj,jk 564 REAL(wp) :: ztemp 565 566 IF (before) THEN 567 DO jk=k1,k2 568 DO jj=j1,j2 569 DO ji=i1,i2 570 tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 571 tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk) 572 tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk) 573 END DO 574 END DO 575 END DO 576 tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 577 tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox() 578 tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy() 579 ELSE 580 DO jk=k1,k2 581 DO jj=j1,j2 582 DO ji=i1,i2 583 IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 584 print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 585 print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) 586 print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk) 587 ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3))) 588 print *,'CORR = ',ztemp-1. 589 print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 590 tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 591 e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp 592 e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp 593 END IF 594 END DO 595 END DO 596 END DO 597 ENDIF 598 ! 599 END SUBROUTINE update_scales 600 601 # if defined key_zdftke 602 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 603 !!--------------------------------------------- 604 !! *** ROUTINE updateen *** 605 !!--------------------------------------------- 606 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 607 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 608 LOGICAL, INTENT(in) :: before 609 !!--------------------------------------------- 610 ! 611 IF (before) THEN 612 ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 613 ELSE 614 en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 615 ENDIF 616 ! 617 END SUBROUTINE updateEN 618 619 620 SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 621 !!--------------------------------------------- 622 !! *** ROUTINE updateavt *** 623 !!--------------------------------------------- 624 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 625 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 626 LOGICAL, INTENT(in) :: before 627 !!--------------------------------------------- 628 ! 629 IF (before) THEN 630 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 631 ELSE 632 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 633 ENDIF 634 ! 635 END SUBROUTINE updateAVT 636 637 638 SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 639 !!--------------------------------------------- 640 !! *** ROUTINE updateavm *** 641 !!--------------------------------------------- 642 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 643 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 644 LOGICAL, INTENT(in) :: before 645 !!--------------------------------------------- 646 ! 647 IF (before) THEN 648 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 649 ELSE 650 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 651 ENDIF 652 ! 653 END SUBROUTINE updateAVM 654 655 # endif /* key_zdftke */ 494 656 495 657 #else
Note: See TracChangeset
for help on using the changeset viewer.