Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/tests/ISOMIP+/MY_SRC/eosbn2.F90
- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
tests/ISOMIP+/MY_SRC/eosbn2.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/tests/ISOMIP+/MY_SRC/eosbn2.F90
r13295 r14037 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 … … 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 ! … … 182 183 !! * Substitutions 183 184 # include "do_loop_substitute.h90" 185 # include "domzgr_substitute.h90" 184 186 !!---------------------------------------------------------------------- 185 187 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 190 192 191 193 SUBROUTINE eos_insitu( pts, prd, pdep ) 194 !! 195 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 196 ! ! 2 : salinity [psu] 197 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 198 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 199 !! 200 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 201 END SUBROUTINE eos_insitu 202 203 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 192 204 !!---------------------------------------------------------------------- 193 205 !! *** ROUTINE eos_insitu *** … … 227 239 !! TEOS-10 Manual, 2010 228 240 !!---------------------------------------------------------------------- 229 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 241 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 242 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 230 243 ! ! 2 : salinity [psu] 231 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]232 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]244 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 245 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 233 246 ! 234 247 INTEGER :: ji, jj, jk ! dummy loop indices … … 311 324 IF( ln_timing ) CALL timing_stop('eos-insitu') 312 325 ! 313 END SUBROUTINE eos_insitu 326 END SUBROUTINE eos_insitu_t 314 327 315 328 316 329 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 330 !! 331 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 332 ! ! 2 : salinity [psu] 333 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 334 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 335 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 336 !! 337 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 338 END SUBROUTINE eos_insitu_pot 339 340 341 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 317 342 !!---------------------------------------------------------------------- 318 343 !! *** ROUTINE eos_insitu_pot *** … … 327 352 !! 328 353 !!---------------------------------------------------------------------- 329 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 354 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 355 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 330 356 ! ! 2 : salinity [psu] 331 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]332 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prhop ! potential density (surface referenced)333 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]357 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 358 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 359 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 334 360 ! 335 361 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 481 507 IF( ln_timing ) CALL timing_stop('eos-pot') 482 508 ! 483 END SUBROUTINE eos_insitu_pot 509 END SUBROUTINE eos_insitu_pot_t 484 510 485 511 486 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !! 514 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 515 ! ! 2 : salinity [psu] 516 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 517 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 518 !! 519 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 520 END SUBROUTINE eos_insitu_2d 521 522 523 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 487 524 !!---------------------------------------------------------------------- 488 525 !! *** ROUTINE eos_insitu_2d *** … … 495 532 !! 496 533 !!---------------------------------------------------------------------- 497 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 534 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 535 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 498 536 ! ! 2 : salinity [psu] 499 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pdep ! depth [m]500 REAL(wp), DIMENSION( jpi,jpj), INTENT( out) :: prd ! in situ density537 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 538 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 501 539 ! 502 540 INTEGER :: ji, jj, jk ! dummy loop indices … … 583 621 IF( ln_timing ) CALL timing_stop('eos2d') 584 622 ! 585 END SUBROUTINE eos_insitu_2d 623 END SUBROUTINE eos_insitu_2d_t 624 625 626 SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 627 !!---------------------------------------------------------------------- 628 !! *** ROUTINE eos_insitu_pot *** 629 !! 630 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 631 !! potential volumic mass (Kg/m3) from potential temperature and 632 !! salinity fields using an equation of state selected in the 633 !! namelist. 634 !! 635 !! ** Action : 636 !! - prhop, the potential volumic mass (Kg/m3) 637 !! 638 !!---------------------------------------------------------------------- 639 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 640 ! ! 2 : salinity [psu] 641 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out) :: prhop ! potential density (surface referenced) 642 ! 643 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 644 INTEGER :: jdof 645 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 646 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 647 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 648 !!---------------------------------------------------------------------- 649 ! 650 IF( ln_timing ) CALL timing_start('eos-pot') 651 ! 652 SELECT CASE ( neos ) 653 ! 654 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 655 ! 656 DO_2D( 1, 1, 1, 1 ) 657 ! 658 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 659 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 660 ztm = tmask(ji,jj,1) ! tmask 661 ! 662 zn0 = (((((EOS060*zt & 663 & + EOS150*zs+EOS050)*zt & 664 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 665 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 666 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 667 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 668 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 669 ! 670 ! 671 prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface 672 ! 673 END_2D 674 675 CASE( np_seos ) !== simplified EOS ==! 676 ! 677 DO_2D( 1, 1, 1, 1 ) 678 zt = pts (ji,jj,jp_tem) - 10._wp 679 zs = pts (ji,jj,jp_sal) - 35._wp 680 ztm = tmask(ji,jj,1) 681 ! ! potential density referenced at the surface 682 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 683 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 684 & - rn_nu * zt * zs 685 prhop(ji,jj) = ( rho0 + zn ) * ztm 686 ! 687 END_2D 688 ! 689 CASE( np_leos ) !== ISOMIP EOS ==! 690 ! 691 DO_2D( 1, 1, 1, 1 ) 692 ! 693 zt = pts (ji,jj,jp_tem) - (-1._wp) 694 zs = pts (ji,jj,jp_sal) - 34.2_wp 695 !zh = pdep (ji,jj) ! depth at the partial step level 696 ! 697 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 698 ! 699 prhop(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 700 ! 701 END_2D 702 ! 703 END SELECT 704 ! 705 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 706 ! 707 IF( ln_timing ) CALL timing_stop('eos-pot') 708 ! 709 END SUBROUTINE eos_insitu_pot_2d 586 710 587 711 588 712 SUBROUTINE rab_3d( pts, pab, Kmm ) 713 !! 714 INTEGER , INTENT(in ) :: Kmm ! time level index 715 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 716 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 717 !! 718 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 719 END SUBROUTINE rab_3d 720 721 722 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 589 723 !!---------------------------------------------------------------------- 590 724 !! *** ROUTINE rab_3d *** … … 597 731 !!---------------------------------------------------------------------- 598 732 INTEGER , INTENT(in ) :: Kmm ! time level index 599 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 600 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 733 INTEGER , INTENT(in ) :: ktts, ktab 734 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 735 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 601 736 ! 602 737 INTEGER :: ji, jj, jk ! dummy loop indices … … 705 840 IF( ln_timing ) CALL timing_stop('rab_3d') 706 841 ! 707 END SUBROUTINE rab_3d 842 END SUBROUTINE rab_3d_t 708 843 709 844 710 845 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 846 !! 847 INTEGER , INTENT(in ) :: Kmm ! time level index 848 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 849 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 850 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 851 !! 852 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 853 END SUBROUTINE rab_2d 854 855 856 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 711 857 !!---------------------------------------------------------------------- 712 858 !! *** ROUTINE rab_2d *** … … 717 863 !!---------------------------------------------------------------------- 718 864 INTEGER , INTENT(in ) :: Kmm ! time level index 719 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 720 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 721 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 865 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 866 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 867 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 868 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 722 869 ! 723 870 INTEGER :: ji, jj, jk ! dummy loop indices … … 828 975 IF( ln_timing ) CALL timing_stop('rab_2d') 829 976 ! 830 END SUBROUTINE rab_2d 977 END SUBROUTINE rab_2d_t 831 978 832 979 … … 941 1088 942 1089 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 1090 !! 1091 INTEGER , INTENT(in ) :: Kmm ! time level index 1092 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 1093 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1094 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 1095 !! 1096 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 1097 END SUBROUTINE bn2 1098 1099 1100 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 943 1101 !!---------------------------------------------------------------------- 944 1102 !! *** ROUTINE bn2 *** … … 955 1113 !!---------------------------------------------------------------------- 956 1114 INTEGER , INTENT(in ) :: Kmm ! time level index 1115 INTEGER , INTENT(in ) :: ktab, ktn2 957 1116 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 958 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]959 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]1117 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1118 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 960 1119 ! 961 1120 INTEGER :: ji, jj, jk ! dummy loop indices … … 965 1124 IF( ln_timing ) CALL timing_start('bn2') 966 1125 ! 967 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 1126 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.F90 968 1127 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 969 1128 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) … … 981 1140 IF( ln_timing ) CALL timing_stop('bn2') 982 1141 ! 983 END SUBROUTINE bn2 1142 END SUBROUTINE bn2_t 984 1143 985 1144 … … 1042 1201 1043 1202 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1203 !! 1204 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1205 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1206 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1207 !! 1208 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1209 END SUBROUTINE eos_fzp_2d 1210 1211 1212 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 1044 1213 !!---------------------------------------------------------------------- 1045 1214 !! *** ROUTINE eos_fzp *** … … 1053 1222 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1054 1223 !!---------------------------------------------------------------------- 1224 INTEGER , INTENT(in ) :: kttf 1055 1225 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1056 1226 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1057 REAL(wp), DIMENSION( jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius]1227 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1058 1228 ! 1059 1229 INTEGER :: ji, jj ! dummy loop indices … … 1088 1258 END SELECT 1089 1259 ! 1090 END SUBROUTINE eos_fzp_2d 1260 END SUBROUTINE eos_fzp_2d_t 1091 1261 1092 1262 … … 1723 1893 ! 1724 1894 CASE( np_leos ) !== Linear ISOMIP EOS ==! 1895 1896 r1_S0 = 0.875_wp/35.16504_wp ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct) 1897 1725 1898 IF(lwp) THEN 1726 1899 WRITE(numout,*) … … 1731 1904 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0 1732 1905 ENDIF 1906 l_useCT = .TRUE. ! Use conservative temperature 1733 1907 ! 1734 1908 CASE DEFAULT !== ERROR in neos ==!
Note: See TracChangeset
for help on using the changeset viewer.
