- 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/eosbn2.F90
r2715 r3211 61 61 62 62 REAL(wp), PUBLIC :: ralpbet !: alpha / beta ratio 63 64 !! * Control permutation of array indices 65 # include "dom_oce_ftrans.h90" 66 # include "zdfddm_ftrans.h90" 63 67 64 68 !! * Substitutions … … 111 115 USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 112 116 !! 117 118 !FTRANS zws :I :I :z 119 !FTRANS pts :I :I :z :I 120 !FTRANS prd :I :I :z 121 113 122 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 114 123 ! ! 2 : salinity [psu] … … 135 144 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 136 145 ! 146 #if defined key_z_first 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 DO jk = 1, jpkm1 150 #else 137 151 DO jk = 1, jpkm1 138 152 DO jj = 1, jpj 139 153 DO ji = 1, jpi 154 #endif 140 155 zt = pts (ji,jj,jk,jp_tem) 141 156 zs = pts (ji,jj,jk,jp_sal) … … 178 193 ! 179 194 CASE( 1 ) !== Linear formulation function of temperature only ==! 195 #if defined key_z_first 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 DO jk = 1, jpkm1 199 prd(ji,jj,jk) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk) 200 END DO 201 END DO 202 END DO 203 #else 180 204 DO jk = 1, jpkm1 181 205 prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 182 206 END DO 207 #endif 183 208 ! 184 209 CASE( 2 ) !== Linear formulation function of temperature and salinity ==! 210 #if defined key_z_first 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 DO jk = 1, jpkm1 214 prd(ji,jj,jk) = ( rn_beta * pts(ji,jj,jk,jp_sal) - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk) 215 END DO 216 END DO 217 END DO 218 #else 185 219 DO jk = 1, jpkm1 186 220 prd(:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 187 221 END DO 222 #endif 188 223 ! 189 224 END SELECT … … 193 228 IF( wrk_not_released(3, 1) ) CALL ctl_stop('eos_insitu: failed to release workspace array') 194 229 ! 230 231 !! * Reset control of array index permutation 232 !FTRANS CLEAR 233 # include "dom_oce_ftrans.h90" 234 # include "zdfddm_ftrans.h90" 235 195 236 END SUBROUTINE eos_insitu 196 237 … … 245 286 USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 246 287 !! 247 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 248 ! ! 2 : salinity [psu] 249 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 250 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 288 289 !FTRANS zws :I :I :z 290 !FTRANS pts :I :I :z :I 291 !FTRANS prd :I :I :z 292 !FTRANS prhop :I :I :z 293 294 !!DCSE NEMO: This style defeats ftrans 295 ! REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 296 ! ! ! 2 : salinity [psu] 297 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 298 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 299 REAL(wp), INTENT(in ) :: pts(jpi,jpj,jpk,jpts) ! 1 : potential temperature [Celcius] 300 ! ! 2 : salinity [psu] 301 REAL(wp), INTENT( out) :: prd(jpi,jpj,jpk) ! in situ density [-] 302 REAL(wp), INTENT( out) :: prhop(jpi,jpj,jpk) ! potential density (surface referenced) 251 303 ! 252 304 INTEGER :: ji, jj, jk ! dummy loop indices … … 266 318 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 267 319 ! 320 #if defined key_z_first 321 DO jj = 1, jpj 322 DO ji = 1, jpi 323 DO jk = 1, jpkm1 324 #else 268 325 DO jk = 1, jpkm1 269 326 DO jj = 1, jpj 270 327 DO ji = 1, jpi 328 #endif 271 329 zt = pts (ji,jj,jk,jp_tem) 272 330 zs = pts (ji,jj,jk,jp_sal) … … 312 370 ! 313 371 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 372 #if defined key_z_first 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 DO jk = 1, jpkm1 376 prd (ji,jj,jk) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk) 377 prhop(ji,jj,jk) = ( 1.e0_wp + prd(ji,jj,jk) ) * rau0 * tmask(ji,jj,jk) 378 END DO 379 END DO 380 END DO 381 #else 314 382 DO jk = 1, jpkm1 315 383 prd (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 316 384 prhop(:,:,jk) = ( 1.e0_wp + prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 317 385 END DO 386 #endif 318 387 ! 319 388 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 389 #if defined key_z_first 390 DO jj = 1, jpj 391 DO ji = 1, jpi 392 DO jk = 1, jpkm1 393 prd (ji,jj,jk) = ( rn_beta * pts(ji,jj,jk,jp_sal) - rn_alpha * pts(ji,jj,jk,jp_tem) ) * tmask(ji,jj,jk) 394 prhop(ji,jj,jk) = ( 1.e0_wp + prd(ji,jj,jk) ) * rau0 * tmask(ji,jj,jk) 395 END DO 396 END DO 397 END DO 398 #else 320 399 DO jk = 1, jpkm1 321 400 prd (:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 322 401 prhop(:,:,jk) = ( 1.e0_wp + prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 323 402 END DO 403 #endif 324 404 ! 325 405 END SELECT … … 329 409 IF( wrk_not_released(3, 1) ) CALL ctl_stop('eos_insitu_pot: failed to release workspace array') 330 410 ! 411 412 !! * Reset control of array index permutation 413 !FTRANS CLEAR 414 # include "dom_oce_ftrans.h90" 415 # include "zdfddm_ftrans.h90" 416 331 417 END SUBROUTINE eos_insitu_pot 332 418 … … 400 486 DO jj = 1, jpjm1 401 487 DO ji = 1, fs_jpim1 ! vector opt. 488 #if defined key_z_first 489 zmask = tmask_1(ji,jj) ! land/sea bottom mask = surf. mask 490 #else 402 491 zmask = tmask(ji,jj,1) ! land/sea bottom mask = surf. mask 492 #endif 403 493 zt = pts (ji,jj,jp_tem) ! interpolated T 404 494 zs = pts (ji,jj,jp_sal) ! interpolated S … … 442 532 DO jj = 1, jpjm1 443 533 DO ji = 1, fs_jpim1 ! vector opt. 534 #if defined key_z_first 535 prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_1(ji,jj) 536 #else 444 537 prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 538 #endif 445 539 END DO 446 540 END DO … … 449 543 DO jj = 1, jpjm1 450 544 DO ji = 1, fs_jpim1 ! vector opt. 545 #if defined key_z_first 546 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask_1(ji,jj) 547 #else 451 548 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 549 #endif 452 550 END DO 453 551 END DO … … 492 590 !! References : McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 493 591 !!---------------------------------------------------------------------- 494 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 495 ! ! 2 : salinity [psu] 496 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 592 593 !FTRANS pts :I :I :z :I 594 !FTRANS pn2 :I :I :z 595 596 !!DCSE_NEMO: This style defeats ftrans 597 ! REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 598 ! ! ! 2 : salinity [psu] 599 ! REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 600 601 REAL(wp), INTENT(in ) :: pts(jpi,jpj,jpk,jpts) ! 1 : potential temperature [Celcius] 602 ! ! 2 : salinity [psu] 603 REAL(wp), INTENT( out) :: pn2(jpi,jpj,jpk) ! Brunt-Vaisala frequency [s-1] 497 604 !! 498 605 INTEGER :: ji, jj, jk ! dummy loop indices … … 509 616 ! 510 617 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 618 #if defined key_z_first 619 DO jj = 1, jpj 620 DO ji = 1, jpi 621 DO jk = 2, jpkm1 622 #else 511 623 DO jk = 2, jpkm1 512 624 DO jj = 1, jpj 513 625 DO ji = 1, jpi 626 #endif 514 627 zgde3w = grav / fse3w(ji,jj,jk) 515 628 zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) ) ! potential temperature at w-pt … … 556 669 ! 557 670 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 671 #if defined key_z_first 672 DO jj = 1, jpj 673 DO ji = 1, jpi 674 DO jk = 2, jpkm1 675 pn2(ji,jj,jk) = grav * rn_alpha * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 676 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 677 END DO 678 END DO 679 END DO 680 #else 558 681 DO jk = 2, jpkm1 559 682 pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 560 683 END DO 684 #endif 561 685 ! 562 686 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 687 #if defined key_z_first 688 DO jj = 1, jpj 689 DO ji = 1, jpi 690 DO jk = 2, jpkm1 691 pn2(ji,jj,jk) = grav * ( rn_alpha * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 692 & - rn_beta * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 693 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 694 END DO 695 END DO 696 END DO 697 #else 563 698 DO jk = 2, jpkm1 564 699 pn2(:,:,jk) = grav * ( rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) & … … 566 701 & / fse3w(:,:,jk) * tmask(:,:,jk) 567 702 END DO 703 #endif 568 704 #if defined key_zdfddm 705 #if defined key_z_first 706 DO jj = 1, jpj ! Rrau = (alpha / beta) (dk[t] / dk[s]) 707 DO ji = 1, jpi 708 DO jk = 2, jpkm1 709 #else 569 710 DO jk = 2, jpkm1 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 570 711 DO jj = 1, jpj 571 712 DO ji = 1, jpi 713 #endif 572 714 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 573 715 IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp … … 584 726 #endif 585 727 ! 728 729 !! * Reset control of array index permutation 730 !FTRANS CLEAR 731 # include "dom_oce_ftrans.h90" 732 # include "zdfddm_ftrans.h90" 733 586 734 END SUBROUTINE eos_bn2 587 735 … … 609 757 !! ** Action : - palph, pbeta : thermal and haline expansion coeff. at T-point 610 758 !!---------------------------------------------------------------------- 611 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 612 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palph, pbeta ! thermal & haline expansion coeff. 759 760 !FTRANS pts :I :I :z :I 761 !FTRANS palph :I :I :z 762 !FTRANS pbeta :I :I :z 763 !!DCSE_NEMO: This style defeats ftrans 764 ! REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 765 ! REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palph, pbeta ! thermal & haline expansion coeff. 766 REAL(wp), INTENT(in ) :: pts(jpi,jpj,jpk,jpts) ! pot. temperature & salinity 767 REAL(wp), INTENT( out) :: palph(jpi,jpj,jpk) ! thermal expansion coeff. 768 REAL(wp), INTENT( out) :: pbeta(jpi,jpj,jpk) ! haline expansion coeff. 613 769 ! 614 770 INTEGER :: ji, jj, jk ! dummy loop indices … … 619 775 ! 620 776 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 777 #if defined key_z_first 778 DO jj = 1, jpj 779 DO ji = 1, jpi 780 DO jk = 1, jpk 781 #else 621 782 DO jk = 1, jpk 622 783 DO jj = 1, jpj 623 784 DO ji = 1, jpi 785 #endif 624 786 zt = pts(ji,jj,jk,jp_tem) ! potential temperature 625 787 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! salinity anomaly (s-35) … … 670 832 END SELECT 671 833 ! 834 835 !! * Reset control of array index permutation 836 !FTRANS CLEAR 837 # include "dom_oce_ftrans.h90" 838 # include "zdfddm_ftrans.h90" 839 672 840 END SUBROUTINE eos_alpbet 673 841
Note: See TracChangeset
for help on using the changeset viewer.
