Changeset 15520 for NEMO/branches/2021
- Timestamp:
- 2021-11-18T16:35:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src
- Files:
-
- 1 deleted
- 4 edited
-
ICE/do_loop_substitute.h90 (deleted)
-
OCE/SBC/sbcblk_algo_coare3p0.F90 (modified) (1 diff)
-
OCE/SBC/sbcblk_algo_coare3p6.F90 (modified) (1 diff)
-
OCE/SBC/sbcblk_algo_ecmwf.F90 (modified) (1 diff)
-
OCE/TRA/eosbn2.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r14790 r15520 91 91 SUBROUTINE turb_coare3p0( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 92 92 & Cd, Ch, Ce, t_zu, q_zu, Ubzu, & 93 & nb_iter, Cd n, Chn, Cen, & ! optional output93 & nb_iter, CdN, ChN, CeN, & ! optional output 94 94 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 95 95 & pdT_wl, pHz_wl ) ! optionals for warm-layer only -
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r14788 r15520 81 81 SUBROUTINE turb_coare3p6( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 82 82 & Cd, Ch, Ce, t_zu, q_zu, Ubzu, & 83 & nb_iter, Cd n, Chn, Cen, & ! optional output83 & nb_iter, CdN, ChN, CeN, & ! optional output 84 84 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 85 85 & pdT_wl, pHz_wl ) ! optionals for warm-layer only -
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r14788 r15520 85 85 SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 86 86 & Cd, Ch, Ce, t_zu, q_zu, Ubzu, & 87 & nb_iter, Cd n, Chn, Cen, & ! optional output87 & nb_iter, CdN, ChN, CeN, & ! optional output 88 88 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 89 89 & pdT_wl, pHz_wl ) ! optionals for warm-layer only -
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/eosbn2.F90
r15066 r15520 56 56 ! !! * Interface 57 57 INTERFACE eos 58 MODULE PROCEDURE eos_insitu_wp, eos_insitu_pot_wp, eos_insitu_2d, eos_insitu_pot_2d 59 MODULE PROCEDURE eos_insitu_mixed, eos_insitu_pot_mixed 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 60 59 END INTERFACE 61 60 ! 62 61 INTERFACE eos_rab 63 MODULE PROCEDURE rab_3d_wp, rab_2d, rab_0d 64 MODULE PROCEDURE rab_3d_mixed 62 MODULE PROCEDURE rab_3d, rab_2d, rab_0d 65 63 END INTERFACE 66 64 ! … … 192 190 CONTAINS 193 191 194 SUBROUTINE eos_insitu _wp( pts, prd, pdep )192 SUBROUTINE eos_insitu( pts, prd, pdep ) 195 193 !! 196 194 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] … … 199 197 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 200 198 !! 201 CALL eos_insitu_t_wp( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 202 END SUBROUTINE eos_insitu_wp 203 204 SUBROUTINE eos_insitu_mixed( pts, prd, pdep ) 205 !! 206 REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 207 ! ! 2 : salinity [psu] 208 REAL(sp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 209 REAL(sp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 210 !! 211 CALL eos_insitu_t_mixed( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 212 END SUBROUTINE 213 214 SUBROUTINE eos_insitu_t_wp( pts, ktts, prd, ktrd, pdep, ktdep ) 199 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 200 END SUBROUTINE eos_insitu 201 202 203 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 215 204 !!---------------------------------------------------------------------- 216 205 !! *** ROUTINE … … 318 307 IF( ln_timing ) CALL timing_stop('eos-insitu') 319 308 ! 320 END SUBROUTINE eos_insitu_t_wp 321 SUBROUTINE eos_insitu_t_mixed( pts, ktts, prd, ktrd, pdep, ktdep ) 322 !!---------------------------------------------------------------------- 323 !! *** ROUTINE eos_insitu *** 324 !! 325 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 326 !! potential temperature and salinity using an equation of state 327 !! selected in the nameos namelist 328 !! 329 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0 330 !! with prd in situ density anomaly no units 331 !! t TEOS10: CT or EOS80: PT Celsius 332 !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu 333 !! z depth meters 334 !! rho in situ density kg/m^3 335 !! rho0 reference density kg/m^3 336 !! 337 !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 338 !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg 339 !! 340 !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z). 341 !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu 342 !! 343 !! ln_seos : simplified equation of state 344 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0 345 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 346 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 347 !! Vallis like equation: use default values of coefficients 348 !! 349 !! ** Action : compute prd , the in situ density (no units) 350 !! 351 !! References : Roquet et al, Ocean Modelling, in preparation (2014) 352 !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 353 !! TEOS-10 Manual, 2010 354 !!---------------------------------------------------------------------- 355 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 356 REAL(dp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 357 ! ! 2 : salinity [psu] 358 REAL(sp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 359 REAL(sp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 360 ! 361 INTEGER :: ji, jj, jk ! dummy loop indices 362 REAL(sp) :: zt , zh , zs , ztm ! local scalars 363 REAL(sp) :: zn , zn0, zn1, zn2, zn3 ! - - 364 !!---------------------------------------------------------------------- 365 ! 366 IF( ln_timing ) CALL timing_start('eos-insitu') 367 ! 368 SELECT CASE( neos ) 369 ! 370 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 371 ! 372 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 373 ! 374 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 375 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 376 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 377 ztm = tmask(ji,jj,jk) ! tmask 378 ! 379 zn3 = EOS013*zt & 380 & + EOS103*zs+EOS003 381 ! 382 zn2 = (EOS022*zt & 383 & + EOS112*zs+EOS012)*zt & 384 & + (EOS202*zs+EOS102)*zs+EOS002 385 ! 386 zn1 = (((EOS041*zt & 387 & + EOS131*zs+EOS031)*zt & 388 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 389 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 390 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 391 ! 392 zn0 = (((((EOS060*zt & 393 & + EOS150*zs+EOS050)*zt & 394 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 395 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 396 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 397 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 398 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 399 ! 400 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 401 ! 402 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 403 ! 404 END_3D 405 ! 406 CASE( np_seos ) !== simplified EOS ==! 407 ! 408 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 409 zt = pts (ji,jj,jk,jp_tem) - 10._wp 410 zs = pts (ji,jj,jk,jp_sal) - 35._wp 411 zh = pdep (ji,jj,jk) 412 ztm = tmask(ji,jj,jk) 413 ! 414 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 415 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 416 & - rn_nu * zt * zs 417 ! 418 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 419 END_3D 420 ! 421 END SELECT 422 ! 423 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=REAL(prd, wp), clinfo1=' eos-insitu : ', kdim=jpk ) 424 ! 425 IF( ln_timing ) CALL timing_stop('eos-insitu') 426 ! 427 END SUBROUTINE eos_insitu_t_mixed 428 429 430 SUBROUTINE eos_insitu_pot_wp( pts, prd, prhop, pdep ) 309 END SUBROUTINE eos_insitu_t 310 311 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 431 312 !! 432 313 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] … … 436 317 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 437 318 !! 438 CALL eos_insitu_pot_t_wp( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 439 END SUBROUTINE eos_insitu_pot_wp 440 441 SUBROUTINE eos_insitu_pot_mixed( pts, prd, prhop, pdep ) 442 !! 443 REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 444 ! ! 2 : salinity [psu] 445 REAL(sp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 446 REAL(dp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 447 REAL(sp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 448 !! 449 CALL eos_insitu_pot_t_mixed( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 450 END SUBROUTINE eos_insitu_pot_mixed 451 452 453 SUBROUTINE eos_insitu_pot_t_wp( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 319 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 320 END SUBROUTINE eos_insitu_pot 321 322 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 454 323 !!---------------------------------------------------------------------- 455 324 !! *** ROUTINE eos_insitu_pot *** … … 605 474 IF( ln_timing ) CALL timing_stop('eos-pot') 606 475 ! 607 END SUBROUTINE eos_insitu_pot_t_wp 608 609 SUBROUTINE eos_insitu_pot_t_mixed( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 610 !!---------------------------------------------------------------------- 611 !! *** ROUTINE eos_insitu_pot *** 612 !! 613 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 614 !! potential volumic mass (Kg/m3) from potential temperature and 615 !! salinity fields using an equation of state selected in the 616 !! namelist. 617 !! 618 !! ** Action : - prd , the in situ density (no units) 619 !! - prhop, the potential volumic mass (Kg/m3) 620 !! 621 !!---------------------------------------------------------------------- 622 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 623 REAL(dp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 624 ! ! 2 : salinity [psu] 625 REAL(sp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 626 REAL(dp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 627 REAL(sp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 628 ! 629 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 630 INTEGER :: jdof 631 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 632 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 633 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 634 !!---------------------------------------------------------------------- 635 ! 636 IF( ln_timing ) CALL timing_start('eos-pot') 637 ! 638 SELECT CASE ( neos ) 639 ! 640 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 641 ! 642 ! Stochastic equation of state 643 IF ( ln_sto_eos ) THEN 644 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 645 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 646 ALLOCATE(zsign(1:2*nn_sto_eos)) 647 DO jsmp = 1, 2*nn_sto_eos, 2 648 zsign(jsmp) = 1._wp 649 zsign(jsmp+1) = -1._wp 650 END DO 651 ! 652 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 653 ! 654 ! compute density (2*nn_sto_eos) times: 655 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 656 ! (2) for t-dt, s-ds (with the opposite fluctuation) 657 DO jsmp = 1, nn_sto_eos*2 658 jdof = (jsmp + 1) / 2 659 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 660 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 661 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 662 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 663 ztm = tmask(ji,jj,jk) ! tmask 664 ! 665 zn3 = EOS013*zt & 666 & + EOS103*zs+EOS003 667 ! 668 zn2 = (EOS022*zt & 669 & + EOS112*zs+EOS012)*zt & 670 & + (EOS202*zs+EOS102)*zs+EOS002 671 ! 672 zn1 = (((EOS041*zt & 673 & + EOS131*zs+EOS031)*zt & 674 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 675 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 676 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 677 ! 678 zn0_sto(jsmp) = (((((EOS060*zt & 679 & + EOS150*zs+EOS050)*zt & 680 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 681 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 682 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 683 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 684 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 685 ! 686 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 687 END DO 688 ! 689 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 690 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 691 DO jsmp = 1, nn_sto_eos*2 692 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 693 ! 694 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 695 END DO 696 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 697 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 698 END_3D 699 DEALLOCATE(zn0_sto,zn_sto,zsign) 700 ! Non-stochastic equation of state 701 ELSE 702 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 703 ! 704 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 705 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 706 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 707 ztm = tmask(ji,jj,jk) ! tmask 708 ! 709 zn3 = EOS013*zt & 710 & + EOS103*zs+EOS003 711 ! 712 zn2 = (EOS022*zt & 713 & + EOS112*zs+EOS012)*zt & 714 & + (EOS202*zs+EOS102)*zs+EOS002 715 ! 716 zn1 = (((EOS041*zt & 717 & + EOS131*zs+EOS031)*zt & 718 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 719 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 720 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 721 ! 722 zn0 = (((((EOS060*zt & 723 & + EOS150*zs+EOS050)*zt & 724 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 725 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 726 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 727 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 728 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 729 ! 730 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 731 ! 732 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 733 ! 734 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 735 END_3D 736 ENDIF 737 738 CASE( np_seos ) !== simplified EOS ==! 739 ! 740 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 741 zt = pts (ji,jj,jk,jp_tem) - 10._wp 742 zs = pts (ji,jj,jk,jp_sal) - 35._wp 743 zh = pdep (ji,jj,jk) 744 ztm = tmask(ji,jj,jk) 745 ! ! potential density referenced at the surface 746 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 747 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 748 & - rn_nu * zt * zs 749 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 750 ! ! density anomaly (masked) 751 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 752 prd(ji,jj,jk) = zn * r1_rho0 * ztm 753 ! 754 END_3D 755 ! 756 END SELECT 757 ! 758 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=REAL(prd, wp), clinfo1=' eos-pot: ', & 759 & tab3d_2=REAL(prhop, wp), clinfo2=' pot : ', kdim=jpk ) 760 ! 761 IF( ln_timing ) CALL timing_stop('eos-pot') 762 ! 763 END SUBROUTINE eos_insitu_pot_t_mixed 764 765 476 END SUBROUTINE eos_insitu_pot_t 477 478 766 479 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 767 480 !! … … 947 660 948 661 949 SUBROUTINE rab_3d _wp( pts, pab, Kmm )662 SUBROUTINE rab_3d( pts, pab, Kmm ) 950 663 !! 951 664 INTEGER , INTENT(in ) :: Kmm ! time level index … … 953 666 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 954 667 !! 955 CALL rab_3d_t_wp( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 956 END SUBROUTINE rab_3d_wp 957 958 SUBROUTINE rab_3d_mixed( pts, pab, Kmm ) 959 !! 960 INTEGER , INTENT(in ) :: Kmm ! time level index 961 REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 962 REAL(sp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 963 !! 964 CALL rab_3d_t_mixed( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 965 END SUBROUTINE rab_3d_mixed 966 967 968 SUBROUTINE rab_3d_t_wp( pts, ktts, pab, ktab, Kmm ) 668 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 669 END SUBROUTINE rab_3d 670 671 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 969 672 !!---------------------------------------------------------------------- 970 673 !! *** ROUTINE rab_3d *** … … 1070 773 IF( ln_timing ) CALL timing_stop('rab_3d') 1071 774 ! 1072 END SUBROUTINE rab_3d_t_wp 1073 1074 SUBROUTINE rab_3d_t_mixed( pts, ktts, pab, ktab, Kmm ) 1075 !!---------------------------------------------------------------------- 1076 !! *** ROUTINE rab_3d *** 1077 !! 1078 !! ** Purpose : Calculates thermal/haline expansion ratio at T-points 1079 !! 1080 !! ** Method : calculates alpha / beta at T-points 1081 !! 1082 !! ** Action : - pab : thermal/haline expansion ratio at T-points 1083 !!---------------------------------------------------------------------- 1084 INTEGER , INTENT(in ) :: Kmm ! time level index 1085 INTEGER , INTENT(in ) :: ktts, ktab 1086 REAL(dp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 1087 REAL(sp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 1088 ! 1089 INTEGER :: ji, jj, jk ! dummy loop indices 1090 REAL(wp) :: zt , zh , zs , ztm ! local scalars 1091 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 1092 !!---------------------------------------------------------------------- 1093 ! 1094 IF( ln_timing ) CALL timing_start('rab_3d') 1095 ! 1096 SELECT CASE ( neos ) 1097 ! 1098 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1099 ! 1100 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 1101 ! 1102 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1103 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1104 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1105 ztm = tmask(ji,jj,jk) ! tmask 1106 ! 1107 ! alpha 1108 zn3 = ALP003 1109 ! 1110 zn2 = ALP012*zt + ALP102*zs+ALP002 1111 ! 1112 zn1 = ((ALP031*zt & 1113 & + ALP121*zs+ALP021)*zt & 1114 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 1115 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 1116 ! 1117 zn0 = ((((ALP050*zt & 1118 & + ALP140*zs+ALP040)*zt & 1119 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 1120 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 1121 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 1122 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 1123 ! 1124 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 1125 ! 1126 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 1127 ! 1128 ! beta 1129 zn3 = BET003 1130 ! 1131 zn2 = BET012*zt + BET102*zs+BET002 1132 ! 1133 zn1 = ((BET031*zt & 1134 & + BET121*zs+BET021)*zt & 1135 & + (BET211*zs+BET111)*zs+BET011)*zt & 1136 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 1137 ! 1138 zn0 = ((((BET050*zt & 1139 & + BET140*zs+BET040)*zt & 1140 & + (BET230*zs+BET130)*zs+BET030)*zt & 1141 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 1142 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 1143 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 1144 ! 1145 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 1146 ! 1147 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 1148 ! 1149 END_3D 1150 ! 1151 CASE( np_seos ) !== simplified EOS ==! 1152 ! 1153 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 1154 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 1155 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1156 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1157 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 1158 ! 1159 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 1160 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 1161 ! 1162 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 1163 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 1164 ! 1165 END_3D 1166 ! 1167 CASE DEFAULT 1168 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 1169 CALL ctl_stop( 'rab_3d:', ctmp1 ) 1170 ! 1171 END SELECT 1172 ! 1173 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=REAL(pab(:,:,:,jp_tem), wp), clinfo1=' rab_3d_t: ', & 1174 & tab3d_2=REAL(pab(:,:,:,jp_sal), wp), clinfo2=' rab_3d_s : ', kdim=jpk ) 1175 ! 1176 IF( ln_timing ) CALL timing_stop('rab_3d') 1177 ! 1178 END SUBROUTINE rab_3d_t_mixed 1179 775 END SUBROUTINE rab_3d_t 1180 776 1181 777 SUBROUTINE rab_2d( pts, pdep, pab, Kmm )
Note: See TracChangeset
for help on using the changeset viewer.
