Changeset 2762 for trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
- Timestamp:
- 2011-05-04T10:25:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r2715 r2762 78 78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bblydta ! frequency of bbl in the y direction at 2 consecutive times 79 79 LOGICAL :: l_offbbl 80 #if defined key_ldfslp 80 #if defined key_ldfslp && ! defined key_c1d 81 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta ! zonal isopycnal slopes 82 82 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta ! meridional isopycnal slopes … … 158 158 ! 159 159 CALL dynrea( kt, MAX( 1, iperm1) ) ! data read for the iperm1 period 160 161 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN ! Computes slopes (here tsn and avt are used as workspace)162 tsn (:,:,:,jp_tem) = tdta (:,:,:,2)163 tsn (:,:,:,jp_sal) = sdta (:,:,:,2)164 avt(:,:,:) = avtdta(:,:,:,2)165 166 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density167 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency168 IF( ln_zps ) &169 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative170 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level171 CALL zdf_mxl( kt ) ! mixed layer depth172 CALL ldf_slp( kt, rhd, rn2 )173 174 uslpdta (:,:,:,2) = uslp (:,:,:)175 vslpdta (:,:,:,2) = vslp (:,:,:)176 wslpidta(:,:,:,2) = wslpi(:,:,:)177 wslpjdta(:,:,:,2) = wslpj(:,:,:)178 END IF179 160 ! 180 161 CALL swap_dyn_data ! swap from record 2 to 1 … … 183 164 ! 184 165 CALL dynrea( kt, iper ) ! data read for the iper period 185 !186 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN ! Computes slopes (here tsn and avt are used as workspace)187 tsn (:,:,:,jp_tem) = tdta (:,:,:,2)188 tsn (:,:,:,jp_sal) = sdta (:,:,:,2)189 avt(:,:,:) = avtdta(:,:,:,2)190 !191 CALL eos( tsn, rhd, rhop ) ! now in situ density192 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency193 IF( ln_zps ) CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative194 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level195 CALL zdf_mxl( kt ) ! mixed layer depth196 CALL ldf_slp( kt, rhd, rn2 ) ! slope of iso-neutral surfaces197 !198 uslpdta (:,:,:,2) = uslp (:,:,:)199 vslpdta (:,:,:,2) = vslp (:,:,:)200 wslpidta(:,:,:,2) = wslpi(:,:,:)201 wslpjdta(:,:,:,2) = wslpj(:,:,:)202 END IF203 166 ! 204 167 lfirdyn = .FALSE. ! trace the first call … … 226 189 CALL dynrea( kt, iper ) ! data read for the iper period 227 190 ! 228 IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN229 ! Computes slopes. Caution : here tsn and avt are used as workspace230 tsn(:,:,:,jp_tem) = tdta (:,:,:,2)231 tsn(:,:,:,jp_sal) = sdta (:,:,:,2)232 avt(:,:,:) = avtdta(:,:,:,2)233 !234 CALL eos( tsn, rhd, rhop ) ! now in situ density235 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency236 IF( ln_zps ) CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative237 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level238 CALL zdf_mxl( kt ) ! mixed layer depth239 CALL ldf_slp( kt, rhd, rn2 ) ! slope of iso-neutral surfaces240 !241 uslpdta (:,:,:,2) = uslp (:,:,:)242 vslpdta (:,:,:,2) = vslp (:,:,:)243 wslpidta(:,:,:,2) = wslpi(:,:,:)244 wslpjdta(:,:,:,2) = wslpj(:,:,:)245 END IF246 !247 191 ndyn1 = ndyn2 ! store the information of the period read 248 192 ndyn2 = iper … … 280 224 CALL bbl( kt, 'TRC') 281 225 END IF 226 ! 282 227 IF(ln_ctl) THEN 283 228 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, ovlap=1, kdim=jpk ) … … 305 250 & udta (jpi,jpj,jpk,2), vdta (jpi,jpj,jpk,2), & 306 251 & wdta (jpi,jpj,jpk,2), avtdta (jpi,jpj,jpk,2), & 307 #if defined key_ldfslp 252 #if defined key_ldfslp && ! defined key_c1d 308 253 & uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & 309 254 & wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), & … … 338 283 !!---------------------------------------------------------------------- 339 284 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 340 USE wrk_nemo, ONLY: zu => wrk_3d_1 , zv => wrk_3d_2 , zw => wrk_3d_3 341 USE wrk_nemo, ONLY: zt => wrk_3d_4 , zs => wrk_3d_5 342 USE wrk_nemo, ONLY: zavt => wrk_3d_6 , zhdiv => wrk_3d_7 343 USE wrk_nemo, ONLY: zahtu => wrk_3d_8 , zahtv => wrk_3d_9 , zahtw => wrk_3d_10 344 USE wrk_nemo, ONLY: zaeiu => wrk_3d_11, zaeiv => wrk_3d_12, zaeiw => wrk_3d_13 345 ! 346 USE wrk_nemo, ONLY: zemp => wrk_2d_1 , zqsr => wrk_2d_2 , zmld => wrk_2d_3 347 USE wrk_nemo, ONLY: zice => wrk_2d_4 , zwspd => wrk_2d_5 348 USE wrk_nemo, ONLY: ztaux => wrk_2d_6 , ztauy => wrk_2d_7 349 USE wrk_nemo, ONLY: zbblx => wrk_2d_8 , zbbly => wrk_2d_9 285 USE wrk_nemo, ONLY: zu => wrk_3d_3 , zv => wrk_3d_4 , zw => wrk_3d_5 286 USE wrk_nemo, ONLY: zt => wrk_3d_6 , zs => wrk_3d_7 , zavt => wrk_3d_8 287 USE wrk_nemo, ONLY: zemp => wrk_2d_11 , zqsr => wrk_2d_12, zmld => wrk_2d_13 288 USE wrk_nemo, ONLY: zice => wrk_2d_14 , zwspd => wrk_2d_15 289 USE wrk_nemo, ONLY: ztaux => wrk_2d_16 , ztauy => wrk_2d_17 290 USE wrk_nemo, ONLY: zbblx => wrk_2d_18 , zbbly => wrk_2d_19 350 291 USE wrk_nemo, ONLY: zaeiw2d => wrk_2d_10 292 USE wrk_nemo, ONLY: ztsn => wrk_4d_1 351 293 ! 352 294 INTEGER, INTENT(in) :: kt, kenr ! time index 353 295 !! 354 296 INTEGER :: jkenr 297 #if defined key_degrad 298 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zahtu, zahtv, zahtw ! Lateral diffusivity 299 # if defined key_traldf_eiv 300 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zaeiu, zaeiv, zaeiw ! G&M coefficient 301 # endif 302 #endif 355 303 !!---------------------------------------------------------------------- 356 304 ! 357 IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 358 wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 305 IF( wrk_in_use(3, 3,4,5,6,7,8) .OR. & 306 wrk_in_use(4, 1) .OR. & 307 wrk_in_use(2, 10,11,12,13,14,15,16,17,18,19) ) THEN 359 308 CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable') ; RETURN 360 309 ENDIF 310 311 #if defined key_degrad 312 ALLOCATE( zahtu(jpi,jpj,jpk), zahtv(jpi,jpj,jpk), zahtw(jpi,jpj,jpk) ) 313 # if defined key_traldf_eiv 314 ALLOCATE( zaeiu(jpi,jpj,jpk), zaeiv(jpi,jpj,jpk), zaeiw(jpi,jpj,jpk) ) 315 # endif 316 #endif 361 317 362 318 ! cas d'un fichier non periodique : on utilise deux fois le premier et … … 414 370 415 371 ! file grid-W 416 !!CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr )372 ! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr ) 417 373 ! Computation of vertical velocity using horizontal divergence 418 CALL wzv( zu, zv, zw , zhdiv)374 CALL wzv( zu, zv, zw ) 419 375 420 376 IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN ! avs exist: it is used … … 439 395 #endif 440 396 441 udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:) 442 vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:) 443 wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 444 445 tdta(:,:,:,2) = zt (:,:,:) * tmask(:,:,:) 446 sdta(:,:,:,2) = zs (:,:,:) * tmask(:,:,:) 397 udta (:,:,:,2) = zu (:,:,:) * umask(:,:,:) 398 vdta (:,:,:,2) = zv (:,:,:) * vmask(:,:,:) 399 wdta (:,:,:,2) = zw (:,:,:) * tmask(:,:,:) 400 tdta (:,:,:,2) = zt (:,:,:) * tmask(:,:,:) 401 sdta (:,:,:,2) = zs (:,:,:) * tmask(:,:,:) 447 402 avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 403 404 #if defined key_ldfslp && ! defined key_c1d 405 ! Computes slopes (here tsn and avt are used as workspace) 406 ztsn (:,:,:,jp_tem) = tdta (:,:,:,2) 407 ztsn (:,:,:,jp_sal) = sdta (:,:,:,2) 408 avt(:,:,:) = avtdta(:,:,:,2) 409 410 CALL eos( ztsn, rhd, rhop ) ! Time-filtered in situ density 411 CALL bn2( ztsn, rn2 ) ! before Brunt-Vaisala frequency 412 IF( ln_zps ) & 413 & CALL zps_hde( kt, jpts, ztsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 414 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 415 CALL zdf_mxl( kt ) ! mixed layer depth 416 CALL ldf_slp( kt, rhd, rn2 ) 417 418 uslpdta (:,:,:,2) = uslp (:,:,:) 419 vslpdta (:,:,:,2) = vslp (:,:,:) 420 wslpidta(:,:,:,2) = wslpi(:,:,:) 421 wslpjdta(:,:,:,2) = wslpj(:,:,:) 422 #endif 448 423 449 424 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv … … 486 461 ENDIF 487 462 ! 488 IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 489 wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 463 IF( wrk_not_released(3, 3,4,5,6,7,8) .OR. & 464 wrk_not_released(4, 1 ) .OR. & 465 wrk_not_released(2, 10,11,12,13,14,15,16,17,18,19) ) THEN 490 466 CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 491 467 END IF 468 #if defined key_degrad 469 DEALLOCATE( zahtu ) ; DEALLOCATE( zahtv ) ; DEALLOCATE( zahtw ) 470 # if defined key_traldf_eiv 471 DEALLOCATE( zaeiu ) ; DEALLOCATE( zaeiv ) ; DEALLOCATE( zaeiw ) 472 # endif 473 #endif 492 474 ! 493 475 END SUBROUTINE dynrea … … 540 522 541 523 542 SUBROUTINE wzv( pu, pv, pw , phdiv)524 SUBROUTINE wzv( pu, pv, pw ) 543 525 !!---------------------------------------------------------------------- 544 526 !! *** ROUTINE wzv *** … … 556 538 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv !: horizontal velocities 557 539 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: verticla velocity 558 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv !: horizontal divergence559 540 !! 560 541 INTEGER :: ji, jj, jk 561 542 REAL(wp) :: zu, zu1, zv, zv1, zet 543 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdiv !: horizontal divergence 562 544 !!---------------------------------------------------------------------- 563 545 ! 564 546 ! Computation of vertical velocity using horizontal divergence 565 phdiv(:,:,:) = 0.547 zhdiv(:,:,:) = 0. 566 548 DO jk = 1, jpkm1 567 549 DO jj = 2, jpjm1 … … 572 554 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 573 555 zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 574 phdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet556 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 575 557 END DO 576 558 END DO 577 559 END DO 578 CALL lbc_lnk( phdiv, 'T', 1. ) ! Lateral boundary conditions on phdiv560 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv 579 561 ! 580 562 ! computation of vertical velocity from the bottom 581 563 pw(:,:,jpk) = 0._wp 582 564 DO jk = jpkm1, 1, -1 583 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk)565 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 584 566 END DO 585 567 !
Note: See TracChangeset
for help on using the changeset viewer.