- Timestamp:
- 2011-09-15T14:38:15+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2782_NOCS_Griffies/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r2715 r2840 3 3 !! *** MODULE eosbn2 *** 4 4 !! Ocean diagnostic variable : equation of state - in situ and potential density 5 !! - Brunt-Vaisala frequency 5 !! - Brunt-Vaisala frequency 6 6 !!============================================================================== 7 7 !! History : OPA ! 1989-03 (O. Marti) Original code … … 27 27 !! eos_insitu_2d : Compute the in situ density for 2d fields 28 28 !! eos_bn2 : Compute the Brunt-Vaisala frequency 29 !! eos_alpbet : calculates the in situ thermal and haline expansion coeff.29 !! eos_alpbet : calculates the in situ thermal/haline expansion ratio 30 30 !! tfreez : Compute the surface freezing temperature 31 31 !! eos_init : set eos parameters (namelist) … … 41 41 PRIVATE 42 42 43 ! !! * Interface 43 ! !! * Interface 44 44 INTERFACE eos 45 45 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 46 END INTERFACE 46 END INTERFACE 47 47 INTERFACE bn2 48 48 MODULE PROCEDURE eos_bn2 49 END INTERFACE 49 END INTERFACE 50 50 51 51 PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules … … 61 61 62 62 REAL(wp), PUBLIC :: ralpbet !: alpha / beta ratio 63 63 64 64 !! * Substitutions 65 65 # include "domzgr_substitute.h90" … … 75 75 !!---------------------------------------------------------------------- 76 76 !! *** ROUTINE eos_insitu *** 77 !! 78 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 77 !! 78 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 79 79 !! potential temperature and salinity using an equation of state 80 80 !! defined through the namelist parameter nn_eos. … … 134 134 !CDIR NOVERRCHK 135 135 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 136 ! 136 ! 137 137 DO jk = 1, jpkm1 138 138 DO jj = 1, jpj … … 199 199 !!---------------------------------------------------------------------- 200 200 !! *** ROUTINE eos_insitu_pot *** 201 !! 201 !! 202 202 !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the 203 203 !! potential volumic mass (Kg/m3) from potential temperature and 204 !! salinity fields using an equation of state defined through the 204 !! salinity fields using an equation of state defined through the 205 205 !! namelist parameter nn_eos. 206 206 !! … … 230 230 !! nn_eos = 2 : linear equation of state function of temperature and 231 231 !! salinity 232 !! prd(t,s) = ( rho(t,s) - rau0 ) / rau0 232 !! prd(t,s) = ( rho(t,s) - rau0 ) / rau0 233 233 !! = rn_beta * s - rn_alpha * tn - 1. 234 234 !! rhop(t,s) = rho(t,s) … … 265 265 !CDIR NOVERRCHK 266 266 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 267 ! 267 ! 268 268 DO jk = 1, jpkm1 269 269 DO jj = 1, jpj … … 336 336 !! *** ROUTINE eos_insitu_2d *** 337 337 !! 338 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 338 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 339 339 !! potential temperature and salinity using an equation of state 340 340 !! defined through the namelist parameter nn_eos. * 2D field case … … 374 374 ! ! 2 : salinity [psu] 375 375 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 376 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 376 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 377 377 !! 378 378 INTEGER :: ji, jj ! dummy loop indices … … 449 449 DO jj = 1, jpjm1 450 450 DO ji = 1, fs_jpim1 ! vector opt. 451 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 451 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 452 452 END DO 453 453 END DO … … 468 468 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time- 469 469 !! step of the input arguments 470 !! 470 !! 471 471 !! ** Method : 472 472 !! * nn_eos = 0 : UNESCO sea water properties … … 482 482 !! N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 483 483 !! The use of potential density to compute N^2 introduces e r r o r 484 !! in the sign of N^2 at great depths. We recommand the use of 484 !! in the sign of N^2 at great depths. We recommand the use of 485 485 !! nn_eos = 0, except for academical studies. 486 486 !! Macro-tasked on horizontal slab (jk-loop) … … 497 497 !! 498 498 INTEGER :: ji, jj, jk ! dummy loop indices 499 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 499 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 500 500 #if defined key_zdfddm 501 501 REAL(wp) :: zds ! local scalars … … 504 504 505 505 ! pn2 : interior points only (2=< jk =< jpkm1 ) 506 ! -------------------------- 506 ! -------------------------- 507 507 ! 508 508 SELECT CASE( nn_eos ) … … 542 542 & - 0.121555e-07_wp ) * zh 543 543 ! 544 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 544 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 545 545 & * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 546 546 & - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) … … 565 565 & - rn_beta * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) ) ) & 566 566 & / fse3w(:,:,jk) * tmask(:,:,jk) 567 END DO 567 END DO 568 568 #if defined key_zdfddm 569 569 DO jk = 2, jpkm1 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 570 570 DO jj = 1, jpj 571 571 DO ji = 1, jpi 572 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 572 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 573 573 IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 574 574 rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds … … 587 587 588 588 589 SUBROUTINE eos_alpbet( pts, palp h, pbeta)590 !!---------------------------------------------------------------------- 591 !! *** ROUTINE ldf_slp_grif***592 !! 593 !! ** Purpose : Calculates the thermal and haline expansion coefficients at T-points.594 !! 595 !! ** Method : calculates alpha and beta at T-points589 SUBROUTINE eos_alpbet( pts, palpbet, beta0 ) 590 !!---------------------------------------------------------------------- 591 !! *** ROUTINE eos_alpbet *** 592 !! 593 !! ** Purpose : Calculates the in situ thermal/haline expansion ratio at T-points 594 !! 595 !! ** Method : calculates alpha / beta ratio at T-points 596 596 !! * nn_eos = 0 : UNESCO sea water properties 597 !! The brunt-vaisala frequency is computed using the polynomial 598 !! polynomial expression of McDougall (1987): 599 !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 600 !! If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 601 !! computed and used in zdfddm module : 602 !! Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 597 !! The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 598 !! polynomial expression of McDougall (1987). 599 !! Scalar beta0 is returned = 1. 603 600 !! * nn_eos = 1 : linear equation of state (temperature only) 604 !! N^2 = grav * rn_alpha * dk[ t ]/e3w 601 !! The ratio is undefined, so we return alpha as palpbet 602 !! Scalar beta0 is returned = 0. 605 603 !! * nn_eos = 2 : linear equation of state (temperature & salinity) 606 !! N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 607 !! * nn_eos = 3 : Jackett JAOT 2003 ??? 608 !! 609 !! ** Action : - palph, pbeta : thermal and haline expansion coeff. at T-point 610 !!---------------------------------------------------------------------- 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. 613 ! 604 !! The alpha/beta ratio is returned as ralpbet 605 !! Scalar beta0 is returned = 1. 606 !! 607 !! ** Action : - palpbet : thermal/haline expansion ratio at T-points 608 !! : beta0 : 1. or 0. 609 !!---------------------------------------------------------------------- 610 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 611 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palpbet ! thermal/haline expansion ratio 612 REAL(wp), INTENT( out) :: beta0 ! set = 1 except with case 1 eos, rho=rho(T) 613 !! 614 614 INTEGER :: ji, jj, jk ! dummy loop indices 615 REAL(wp) :: zt, zs, zh ! local scalars 615 REAL(wp) :: zt, zs, zh ! local scalars 616 616 !!---------------------------------------------------------------------- 617 617 ! … … 624 624 zt = pts(ji,jj,jk,jp_tem) ! potential temperature 625 625 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! salinity anomaly (s-35) 626 zh = fsdept(ji,jj,jk) ! depth in meters 627 ! 628 pbeta(ji,jj,jk) = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt & 629 & - 0.301985e-05_wp ) * zt & 630 & + 0.785567e-03_wp & 631 & + ( 0.515032e-08_wp * zs & 632 & + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs & 633 & + ( ( 0.121551e-17_wp * zh & 634 & - 0.602281e-15_wp * zs & 635 & - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh & 636 & + 0.408195e-10_wp * zs & 637 & + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt & 638 & - 0.121555e-07_wp ) * zh 639 ! 640 palph(ji,jj,jk) = - pbeta(ji,jj,jk) * & 641 & ((( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & 642 & - 0.203814e-03_wp ) * zt & 643 & + 0.170907e-01_wp ) * zt & 644 & + 0.665157e-01_wp & 645 & + ( - 0.678662e-05_wp * zs & 646 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs & 647 & + ( ( - 0.302285e-13_wp * zh & 648 & - 0.251520e-11_wp * zs & 649 & + 0.512857e-12_wp * zt * zt ) * zh & 650 & - 0.164759e-06_wp * zs & 651 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt & 652 & + 0.380374e-04_wp ) * zh) 626 zh = fsdept(ji,jj,jk) ! depth in meters 627 ! 628 palpbet(ji,jj,jk) = & 629 & ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & 630 & - 0.203814e-03_wp ) * zt & 631 & + 0.170907e-01_wp ) * zt & 632 & + 0.665157e-01_wp & 633 & + ( - 0.678662e-05_wp * zs & 634 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs & 635 & + ( ( - 0.302285e-13_wp * zh & 636 & - 0.251520e-11_wp * zs & 637 & + 0.512857e-12_wp * zt * zt ) * zh & 638 & - 0.164759e-06_wp * zs & 639 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt & 640 & + 0.380374e-04_wp ) * zh 653 641 END DO 654 642 END DO 655 643 END DO 656 ! 657 CASE ( 1 ) 658 palph(:,:,:) = - rn_alpha 659 pbeta(:,:,:) = 0._wp 660 ! 661 CASE ( 2 ) 662 palph(:,:,:) = - rn_alpha 663 pbeta(:,:,:) = rn_beta 644 beta0 = 1._wp 645 ! 646 CASE ( 1 ) !== Linear formulation = F( temperature ) ==! 647 palpbet(:,:,:) = rn_alpha 648 beta0 = 0._wp 649 ! 650 CASE ( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 651 palpbet(:,:,:) = ralpbet 652 beta0 = 1._wp 664 653 ! 665 654 CASE DEFAULT … … 747 736 748 737 !!====================================================================== 749 END MODULE eosbn2 738 END MODULE eosbn2
Note: See TracChangeset
for help on using the changeset viewer.
