- Timestamp:
- 2011-12-11T16:00:26+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r2715 r3211 64 64 INTEGER :: nn_file = 2 ! = 1 create a damping.coeff NetCDF file 65 65 66 !! * Control permutation of array indices 67 # include "oce_ftrans.h90" 68 # include "dom_oce_ftrans.h90" 69 # include "zdf_oce_ftrans.h90" 70 # include "dtatem_ftrans.h90" 71 # include "dtasal_ftrans.h90" 72 # include "tradmp_ftrans.h90" 73 66 74 !! * Substitutions 67 75 # include "domzgr_substitute.h90" … … 112 120 ! 113 121 CASE( 0 ) !== newtonian damping throughout the water column ==! 122 #if defined key_z_first 123 DO jj = 2, jpjm1 124 DO ji = 2, jpim1 125 DO jk = 1, jpkm1 126 #else 114 127 DO jk = 1, jpkm1 115 128 DO jj = 2, jpjm1 116 129 DO ji = fs_2, fs_jpim1 ! vector opt. 130 #endif 117 131 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 118 132 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) … … 126 140 ! 127 141 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 142 #if defined key_z_first 143 DO jj = 2, jpjm1 144 DO ji = 2, jpim1 145 DO jk = 1, jpkm1 146 #else 128 147 DO jk = 1, jpkm1 129 148 DO jj = 2, jpjm1 130 149 DO ji = fs_2, fs_jpim1 ! vector opt. 150 #endif 131 151 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 132 152 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) … … 145 165 ! 146 166 CASE ( 2 ) !== no damping in the mixed layer ==! 167 #if defined key_z_first 168 DO jj = 2, jpjm1 169 DO ji = 2, jpim1 170 DO jk = 1, jpkm1 171 #else 147 172 DO jk = 1, jpkm1 148 173 DO jj = 2, jpjm1 149 174 DO ji = fs_2, fs_jpim1 ! vector opt. 175 #endif 150 176 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 151 177 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) … … 252 278 !! ** Action : - resto, the damping coeff. for T and S 253 279 !!---------------------------------------------------------------------- 254 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1) 280 281 !! DCSE_NEMO: This style defeats ftrans 282 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1) 283 !FTRANS presto :I :I :z 284 REAL(wp), INTENT(inout) :: presto(jpi,jpj,jpk) ! restoring coeff. (s-1) 255 285 ! 256 286 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 292 322 z1_5d = 1._wp / ( 5._wp * rday ) ! z1_5d : 1 / 5days 293 323 324 #if defined key_z_first 325 DO jj = 1, jpj ! Compute arrays resto ; value for internal damping : 5 days 326 DO ji = 1, jpi 327 DO jk = 2, jpkm1 328 #else 294 329 DO jk = 2, jpkm1 ! Compute arrays resto ; value for internal damping : 5 days 295 330 DO jj = 1, jpj 296 331 DO ji = 1, jpi 332 #endif 297 333 zlat = ABS( gphit(ji,jj) ) 298 334 IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN … … 311 347 END SUBROUTINE dtacof_zoom 312 348 349 !! * Reset control of array index permutation 350 !FTRANS CLEAR 351 # include "oce_ftrans.h90" 352 # include "dom_oce_ftrans.h90" 353 # include "zdf_oce_ftrans.h90" 354 # include "dtatem_ftrans.h90" 355 # include "dtasal_ftrans.h90" 356 # include "tradmp_ftrans.h90" 313 357 314 358 SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep, & … … 329 373 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 330 374 USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct => wrk_3d_1 ! 1D, 2D, 3D workspace 375 376 !! DCSE_NEMO: need additional directives for renamed module variables 377 !FTRANS zdct :I :I :z 378 331 379 !! 332 380 INTEGER , INTENT(in ) :: kn_hdmp ! damping option … … 336 384 INTEGER , INTENT(in ) :: kn_file ! save the damping coef on a file or not 337 385 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 338 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1) 386 387 !! DCSE_NEMO: This style defeats ftrans 388 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1) 389 !FTRANS presto :I :I :z 390 REAL(wp), INTENT(inout) :: presto(jpi,jpj,jpk) ! restoring coeff. (s-1) 391 339 392 ! 340 393 INTEGER :: ji, jj, jk ! dummy loop indices … … 407 460 zsdmp = 1._wp / ( pn_surf * rday ) 408 461 zbdmp = 1._wp / ( pn_bot * rday ) 462 #if defined key_z_first 463 DO jj = 1, jpj 464 DO ji = 1, jpi 465 DO jk = 2, jpkm1 466 #else 409 467 DO jk = 2, jpkm1 410 468 DO jj = 1, jpj 411 469 DO ji = 1, jpi 470 #endif 412 471 zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) ) 413 472 ! ... Decrease the value in the vicinity of the coast … … 518 577 END SELECT 519 578 579 #if defined key_z_first 580 DO jj = 1, jpj 581 DO ji = 1, jpi 582 DO jk = 1, jpkm1 583 presto(ji,jj,jk) = zmrs(ji,jj) * zhfac(jk) + ( 1._wp - zmrs(ji,jj) ) * presto(ji,jj,jk) 584 END DO 585 END DO 586 END DO 587 #else 520 588 DO jk = 1, jpkm1 521 589 presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk) 522 590 END DO 591 #endif 523 592 524 593 ! Mask resto array and set to 0 first and last levels … … 550 619 END SUBROUTINE dtacof 551 620 621 !! * Reset control of array index permutation 622 !FTRANS CLEAR 623 # include "oce_ftrans.h90" 624 # include "dom_oce_ftrans.h90" 625 # include "zdf_oce_ftrans.h90" 626 # include "dtatem_ftrans.h90" 627 # include "dtasal_ftrans.h90" 628 # include "tradmp_ftrans.h90" 552 629 553 630 SUBROUTINE cofdis( pdct ) … … 571 648 !! - NetCDF file 'dist.coast.nc' 572 649 !!---------------------------------------------------------------------- 573 USE ioipsl ! IOipsl libra iry650 USE ioipsl ! IOipsl library 574 651 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 575 652 USE wrk_nemo, ONLY: zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 576 653 !! 654 655 !! DCSE_NEMO: This style defeats ftrans 656 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline 657 !FTRANS pdct :I :I :z 577 658 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline 659 578 660 !! 579 661 INTEGER :: ji, jj, jk, jl ! dummy loop indices
Note: See TracChangeset
for help on using the changeset viewer.
