Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/eosbn2.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/eosbn2.F90
r13497 r14789 31 31 !! bn2 : compute the Brunt-Vaisala frequency 32 32 !! eos_pt_from_ct: compute the potential temperature from the Conservative Temperature 33 !! eos_rab : generic interface of in situ thermal/haline expansion ratio 33 !! eos_rab : generic interface of in situ thermal/haline expansion ratio 34 34 !! eos_rab_3d : compute in situ thermal/haline expansion ratio 35 35 !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields … … 39 39 !!---------------------------------------------------------------------- 40 40 USE dom_oce ! ocean space and time domain 41 USE domutl, ONLY : is_tile 41 42 USE phycst ! physical constants 42 43 USE stopar ! Stochastic T/S fluctuations … … 45 46 USE in_out_manager ! I/O manager 46 47 USE lib_mpp ! MPP library 47 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 48 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 48 49 USE prtctl ! Print control 49 50 USE lbclnk ! ocean lateral boundary conditions … … 55 56 ! !! * Interface 56 57 INTERFACE eos 57 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 58 59 END INTERFACE 59 60 ! … … 62 63 END INTERFACE 63 64 ! 64 INTERFACE eos_fzp 65 INTERFACE eos_fzp 65 66 MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d 66 67 END INTERFACE … … 88 89 89 90 ! !!! simplified eos coefficients (default value: Vallis 2006) 90 REAL(wp) :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff.91 REAL(wp) :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff.92 REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2 93 REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2 94 REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T 95 REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S 96 REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt 97 91 REAL(wp), PUBLIC :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff. 92 REAL(wp), PUBLIC :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff. 93 REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2 94 REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2 95 REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T 96 REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S 97 REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt 98 98 99 ! TEOS10/EOS80 parameters 99 100 REAL(wp) :: r1_S0, r1_T0, r1_Z0, rdeltaS 100 101 101 102 ! EOS parameters 102 103 REAL(wp) :: EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 … … 116 117 REAL(wp) :: EOS022 117 118 REAL(wp) :: EOS003 , EOS103 118 REAL(wp) :: EOS013 119 119 REAL(wp) :: EOS013 120 120 121 ! ALPHA parameters 121 122 REAL(wp) :: ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 … … 132 133 REAL(wp) :: ALP012 133 134 REAL(wp) :: ALP003 134 135 135 136 ! BETA parameters 136 137 REAL(wp) :: BET000 , BET100 , BET200 , BET300 , BET400 , BET500 … … 159 160 REAL(wp) :: PEN002 , PEN102 160 161 REAL(wp) :: PEN012 161 162 162 163 ! ALPHA_PEN parameters 163 164 REAL(wp) :: APE000 , APE100 , APE200 , APE300 … … 189 190 190 191 SUBROUTINE eos_insitu( pts, prd, pdep ) 192 !! 193 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 194 ! ! 2 : salinity [psu] 195 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 196 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 197 !! 198 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 199 END SUBROUTINE eos_insitu 200 201 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 191 202 !!---------------------------------------------------------------------- 192 203 !! *** ROUTINE eos_insitu *** … … 222 233 !! TEOS-10 Manual, 2010 223 234 !!---------------------------------------------------------------------- 224 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 225 ! ! 2 : salinity [psu] 226 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 227 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 235 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 236 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 237 ! ! 2 : salinity [psu] 238 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 239 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 228 240 ! 229 241 INTEGER :: ji, jj, jk ! dummy loop indices … … 238 250 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 239 251 ! 240 DO_3D( 1, 1, 1, 1, 1, jpkm1 )252 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 241 253 ! 242 254 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 274 286 CASE( np_seos ) !== simplified EOS ==! 275 287 ! 276 DO_3D( 1, 1, 1, 1, 1, jpkm1 )288 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 277 289 zt = pts (ji,jj,jk,jp_tem) - 10._wp 278 290 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 283 295 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 284 296 & - rn_nu * zt * zs 285 ! 297 ! 286 298 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 287 299 END_3D … … 293 305 IF( ln_timing ) CALL timing_stop('eos-insitu') 294 306 ! 295 END SUBROUTINE eos_insitu 307 END SUBROUTINE eos_insitu_t 296 308 297 309 298 310 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 311 !! 312 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 313 ! ! 2 : salinity [psu] 314 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 315 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 316 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 317 !! 318 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 319 END SUBROUTINE eos_insitu_pot 320 321 322 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 299 323 !!---------------------------------------------------------------------- 300 324 !! *** ROUTINE eos_insitu_pot *** … … 309 333 !! 310 334 !!---------------------------------------------------------------------- 311 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 312 ! ! 2 : salinity [psu] 313 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 335 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 336 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 337 ! ! 2 : salinity [psu] 338 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 339 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 340 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 316 341 ! 317 342 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 338 363 END DO 339 364 ! 340 DO_3D( 1, 1, 1, 1, 1, jpkm1 )365 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 341 366 ! 342 367 ! compute density (2*nn_sto_eos) times: … … 388 413 ! Non-stochastic equation of state 389 414 ELSE 390 DO_3D( 1, 1, 1, 1, 1, jpkm1 )415 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 391 416 ! 392 417 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 423 448 END_3D 424 449 ENDIF 425 450 426 451 CASE( np_seos ) !== simplified EOS ==! 427 452 ! 428 DO_3D( 1, 1, 1, 1, 1, jpkm1 )453 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 429 454 zt = pts (ji,jj,jk,jp_tem) - 10._wp 430 455 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 444 469 END SELECT 445 470 ! 446 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 471 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', & 472 & tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 447 473 ! 448 474 IF( ln_timing ) CALL timing_stop('eos-pot') 449 475 ! 450 END SUBROUTINE eos_insitu_pot 476 END SUBROUTINE eos_insitu_pot_t 451 477 452 478 453 479 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 480 !! 481 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 482 ! ! 2 : salinity [psu] 483 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 484 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 485 !! 486 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 487 END SUBROUTINE eos_insitu_2d 488 489 490 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 454 491 !!---------------------------------------------------------------------- 455 492 !! *** ROUTINE eos_insitu_2d *** … … 462 499 !! 463 500 !!---------------------------------------------------------------------- 464 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 465 ! ! 2 : salinity [psu] 466 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 467 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 501 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 502 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 503 ! ! 2 : salinity [psu] 504 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 505 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 468 506 ! 469 507 INTEGER :: ji, jj, jk ! dummy loop indices … … 480 518 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 481 519 ! 482 DO_2D( 1, 1, 1, 1)520 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 483 521 ! 484 522 zh = pdep(ji,jj) * r1_Z0 ! depth … … 515 553 CASE( np_seos ) !== simplified EOS ==! 516 554 ! 517 DO_2D( 1, 1, 1, 1)555 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 518 556 ! 519 557 zt = pts (ji,jj,jp_tem) - 10._wp … … 535 573 IF( ln_timing ) CALL timing_stop('eos2d') 536 574 ! 537 END SUBROUTINE eos_insitu_2d 575 END SUBROUTINE eos_insitu_2d_t 576 577 578 SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 579 !!---------------------------------------------------------------------- 580 !! *** ROUTINE eos_insitu_pot *** 581 !! 582 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 583 !! potential volumic mass (Kg/m3) from potential temperature and 584 !! salinity fields using an equation of state selected in the 585 !! namelist. 586 !! 587 !! ** Action : 588 !! - prhop, the potential volumic mass (Kg/m3) 589 !! 590 !!---------------------------------------------------------------------- 591 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 592 ! ! 2 : salinity [psu] 593 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out) :: prhop ! potential density (surface referenced) 594 ! 595 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 596 INTEGER :: jdof 597 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 598 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 599 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 600 !!---------------------------------------------------------------------- 601 ! 602 IF( ln_timing ) CALL timing_start('eos-pot') 603 ! 604 SELECT CASE ( neos ) 605 ! 606 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 607 ! 608 DO_2D( 1, 1, 1, 1 ) 609 ! 610 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 611 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 612 ztm = tmask(ji,jj,1) ! tmask 613 ! 614 zn0 = (((((EOS060*zt & 615 & + EOS150*zs+EOS050)*zt & 616 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 617 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 618 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 619 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 620 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 621 ! 622 ! 623 prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface 624 ! 625 END_2D 626 627 CASE( np_seos ) !== simplified EOS ==! 628 ! 629 DO_2D( 1, 1, 1, 1 ) 630 zt = pts (ji,jj,jp_tem) - 10._wp 631 zs = pts (ji,jj,jp_sal) - 35._wp 632 ztm = tmask(ji,jj,1) 633 ! ! potential density referenced at the surface 634 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 635 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 636 & - rn_nu * zt * zs 637 prhop(ji,jj) = ( rho0 + zn ) * ztm 638 ! 639 END_2D 640 ! 641 END SELECT 642 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 ) 643 ! 644 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 645 ! 646 IF( ln_timing ) CALL timing_stop('eos-pot') 647 ! 648 END SUBROUTINE eos_insitu_pot_2d 538 649 539 650 540 651 SUBROUTINE rab_3d( pts, pab, Kmm ) 652 !! 653 INTEGER , INTENT(in ) :: Kmm ! time level index 654 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 655 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 656 !! 657 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 658 END SUBROUTINE rab_3d 659 660 661 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 541 662 !!---------------------------------------------------------------------- 542 663 !! *** ROUTINE rab_3d *** … … 548 669 !! ** Action : - pab : thermal/haline expansion ratio at T-points 549 670 !!---------------------------------------------------------------------- 550 INTEGER , INTENT(in ) :: Kmm ! time level index 551 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 552 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 671 INTEGER , INTENT(in ) :: Kmm ! time level index 672 INTEGER , INTENT(in ) :: ktts, ktab 673 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 674 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 553 675 ! 554 676 INTEGER :: ji, jj, jk ! dummy loop indices … … 563 685 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 564 686 ! 565 DO_3D( 1, 1, 1, 1, 1, jpkm1 )687 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 566 688 ! 567 689 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth … … 616 738 CASE( np_seos ) !== simplified EOS ==! 617 739 ! 618 DO_3D( 1, 1, 1, 1, 1, jpkm1 )740 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 619 741 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 620 742 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) … … 641 763 IF( ln_timing ) CALL timing_stop('rab_3d') 642 764 ! 643 END SUBROUTINE rab_3d 765 END SUBROUTINE rab_3d_t 644 766 645 767 646 768 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 769 !! 770 INTEGER , INTENT(in ) :: Kmm ! time level index 771 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 772 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 773 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 774 !! 775 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 776 END SUBROUTINE rab_2d 777 778 779 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 647 780 !!---------------------------------------------------------------------- 648 781 !! *** ROUTINE rab_2d *** … … 652 785 !! ** Action : - pab : thermal/haline expansion ratio at T-points 653 786 !!---------------------------------------------------------------------- 654 INTEGER , INTENT(in ) :: Kmm ! time level index 655 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 656 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 657 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 787 INTEGER , INTENT(in ) :: Kmm ! time level index 788 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 789 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 790 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 791 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 658 792 ! 659 793 INTEGER :: ji, jj, jk ! dummy loop indices … … 670 804 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 671 805 ! 672 DO_2D( 1, 1, 1, 1)806 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 673 807 ! 674 808 zh = pdep(ji,jj) * r1_Z0 ! depth … … 723 857 CASE( np_seos ) !== simplified EOS ==! 724 858 ! 725 DO_2D( 1, 1, 1, 1)859 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 726 860 ! 727 861 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) … … 748 882 IF( ln_timing ) CALL timing_stop('rab_2d') 749 883 ! 750 END SUBROUTINE rab_2d 884 END SUBROUTINE rab_2d_t 751 885 752 886 … … 849 983 850 984 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 985 !! 986 INTEGER , INTENT(in ) :: Kmm ! time level index 987 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 988 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 989 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 990 !! 991 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 992 END SUBROUTINE bn2 993 994 995 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 851 996 !!---------------------------------------------------------------------- 852 997 !! *** ROUTINE bn2 *** 853 998 !! 854 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the 999 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the 855 1000 !! time-step of the input arguments 856 1001 !! … … 859 1004 !! N.B. N^2 is set one for all to zero at jk=1 in istate module. 860 1005 !! 861 !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point 862 !! 863 !!---------------------------------------------------------------------- 864 INTEGER , INTENT(in ) :: Kmm ! time level index 865 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 866 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 867 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 1006 !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point 1007 !! 1008 !!---------------------------------------------------------------------- 1009 INTEGER , INTENT(in ) :: Kmm ! time level index 1010 INTEGER , INTENT(in ) :: ktab, ktn2 1011 REAL(wp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 1012 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1013 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 868 1014 ! 869 1015 INTEGER :: ji, jj, jk ! dummy loop indices … … 873 1019 IF( ln_timing ) CALL timing_start('bn2') 874 1020 ! 875 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F901021 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 876 1022 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 877 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 878 ! 879 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 1023 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 1024 ! 1025 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 880 1026 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 881 1027 ! … … 889 1035 IF( ln_timing ) CALL timing_stop('bn2') 890 1036 ! 891 END SUBROUTINE bn2 1037 END SUBROUTINE bn2_t 892 1038 893 1039 … … 949 1095 950 1096 951 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1097 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1098 !! 1099 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1100 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1101 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1102 !! 1103 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1104 END SUBROUTINE eos_fzp_2d 1105 1106 1107 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 952 1108 !!---------------------------------------------------------------------- 953 1109 !! *** ROUTINE eos_fzp *** … … 961 1117 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 962 1118 !!---------------------------------------------------------------------- 963 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 964 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 965 REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1119 INTEGER , INTENT(in ) :: kttf 1120 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu] 1121 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m] 1122 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 966 1123 ! 967 1124 INTEGER :: ji, jj ! dummy loop indices … … 994 1151 CALL ctl_stop( 'eos_fzp_2d:', ctmp1 ) 995 1152 ! 996 END SELECT 997 ! 998 END SUBROUTINE eos_fzp_2d 1153 END SELECT 1154 ! 1155 END SUBROUTINE eos_fzp_2d_t 999 1156 1000 1157 … … 1051 1208 !! ** Purpose : Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 1052 1209 !! 1053 !! ** Method : PE is defined analytically as the vertical 1210 !! ** Method : PE is defined analytically as the vertical 1054 1211 !! primitive of EOS times -g integrated between 0 and z>0. 1055 1212 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd 1056 !! = 1/z * /int_0^z rd dz - rd 1213 !! = 1/z * /int_0^z rd dz - rd 1057 1214 !! where rd is the density anomaly (see eos_rhd function) 1058 1215 !! ab_pe are partial derivatives of PE anomaly with respect to T and S: … … 1118 1275 ! 1119 1276 zn = ( zn2 * zh + zn1 ) * zh + zn0 1120 ! 1277 ! 1121 1278 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1122 1279 ! … … 1133 1290 ! 1134 1291 zn = ( zn2 * zh + zn1 ) * zh + zn0 1135 ! 1292 ! 1136 1293 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1137 1294 ! … … 1213 1370 IF(lwp) WRITE(numout,*) ' ==>>> use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 1214 1371 ! 1215 l_useCT = .TRUE. ! model temperature is Conservative temperature 1372 l_useCT = .TRUE. ! model temperature is Conservative temperature 1216 1373 ! 1217 1374 rdeltaS = 32._wp … … 1594 1751 1595 1752 r1_S0 = 0.875_wp/35.16504_wp ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct) 1596 1753 1597 1754 IF(lwp) THEN 1598 1755 WRITE(numout,*) … … 1618 1775 END SELECT 1619 1776 ! 1620 rho0_rcp = rho0 * rcp 1777 rho0_rcp = rho0 * rcp 1621 1778 r1_rho0 = 1._wp / rho0 1622 1779 r1_rcp = 1._wp / rcp 1623 r1_rho0_rcp = 1._wp / rho0_rcp 1780 r1_rho0_rcp = 1._wp / rho0_rcp 1624 1781 ! 1625 1782 IF(lwp) THEN
Note: See TracChangeset
for help on using the changeset viewer.