source: trunk/SRC/ToBeReviewed/CALCULS/rhon.pro

;+
;
; Calcul de la fonction d'etat (issue de eos.F)
;
; @categories
;
; @param SN
;
; @param TN
;
; @keyword INSITU
;
; @keyword SIGMA_N
;
; @returns
;
; @uses
;
; @restrictions
;
; @examples
;
; @history
;
; - Creation : 1997 / G. Roullet
;
; - adaptation pour les tableaux z,zt,xyz,xyzt  par seb.
;
; @version
; $Id$
;
; @todo seb
;
;-
FUNCTION rhon, sn, tn, INSITU=insitu, SIGMA_N=sigma_n
;
  compile_opt idl2, strictarrsubs
;
@common
   tempsun = systime(1)         ; pour key_performance
      sn = -1e5 > double(sn) < 1e5
      tn = -1e5 > double(tn) < 1e5

      IF keyword_set(sigma_n) then insitu = 1

   taille = size(sn)
   case taille[0] of
      0:BEGIN                   ;z
         zrhop=0d
         jkmax = 1
      END
      1:BEGIN                   ;z
         zrhop=dblarr(taille[1])
         jkmax = taille[1]
      END
      2:BEGIN                   ;xy (jpt=1) ou zt
         zrhop=dblarr(taille[1],taille[2])
         if jpt EQ 1 then jkmax = 1 ELSE jkmax = taille[1]
      END
      3:BEGIN                   ;xyz (jpt=1) ou xyt
         zrhop=dblarr(taille[1],taille[2],taille[3])
         if jpt EQ 1 then jkmax = taille[3] ELSE jkmax = 1
      END
      4:BEGIN                   ;xyzt
         zrhop=dblarr(taille[1],taille[2],taille[3],taille[4] )
         jkmax = taille[3]
      END
   endcase

   FOR jk = 0, jkmax-1 DO BEGIN

      case taille[0] of
         0:BEGIN                ;z
            ztt = tn
            zs = sn
         END
         1:BEGIN                ;z
            ztt = tn[jk]
            zs = sn[jk]
         END
         2:BEGIN                ;xy (jpt=1) ou zt
            if jpt EQ 1 then begin
               ztt = tn
               zs = sn
            ENDIF ELSE BEGIN
               ztt = tn[jk, *]
               zs = sn[jk, *]
            ENDELSE
         END
         3:BEGIN                ;xyz (jpt=1) ou xyt
            if jpt EQ 1 then begin
               ztt = tn[*, *, jk]
               zs = sn[*, *,jk]
            endif ELSE BEGIN
               ztt = tn
               zs = sn
            ENDELSE
         END
         4:BEGIN                ;xyzt
            ztt = tn[*, *, jk, *]
            zs = sn[*, *,jk, *]
         END
      endcase
      if n_elements(sigma_n) NE 0 then zh = 1000.*sigma_n ELSE zh = gdept[jk]
; ...   square root salinity
      zsr= sqrt(abs(zs))
; ...   compute density pure water at atm pressure
      zr1=((((6.536332e-9*ztt-1.120083e-6)*ztt+1.001685e-4)*ztt-9.095290e-3)*ztt+6.793952e-2)*ztt+999.842594
; ...   seawater density atm pressure
      zr2= (((5.3875e-9*ztt-8.2467e-7)*ztt+7.6438e-5)*ztt-4.0899e-3)*ztt+0.824493
      zr3= (-1.6546e-6*ztt+1.0227e-4)*ztt-5.72466e-3
      zr4= 4.8314e-4
;
; ...   potential density (reference to the surface)
      case taille[0] of
         0: zrhop    = (zr4*zs + zr3*zsr + zr2)*zs + zr1
         1: zrhop[jk]= (zr4*zs + zr3*zsr + zr2)*zs + zr1
         2:BEGIN
            if jpt EQ 1 then zrhop = (zr4*zs + zr3*zsr + zr2)*zs + zr1 $
            ELSE zrhop[jk, *]= (zr4*zs + zr3*zsr + zr2)*zs + zr1
         END
         3:BEGIN
            if jpt EQ 1 then zrhop[*, *,jk]= (zr4*zs + zr3*zsr + zr2)*zs + zr1 $
             ELSE zrhop = (zr4*zs + zr3*zsr + zr2)*zs + zr1
         END
         4: zrhop[*, *,jk, *]= (zr4*zs + zr3*zsr + zr2)*zs + zr1
      endcase

      IF n_elements(insitu) EQ 1 THEN BEGIN
; ...   add the compression terms
         ze = (-3.508914e-8*ztt-1.248266e-8)*ztt-2.595994e-6
         zbw= ( 1.296821e-6*ztt-5.782165e-9)*ztt+1.045941e-4
         zb = zbw + ze * zs
;
         zd = -2.042967e-2
         zc = (-7.267926e-5*ztt+2.598241e-3)*ztt+0.1571896
         zaw = ((5.939910e-6*ztt+2.512549e-3)*ztt-0.1028859)*ztt -4.721788
         za = ( zd*zsr + zc)*zs + zaw
;
         zb1= (-0.1909078*ztt+7.390729)*ztt-55.87545
         za1= ((2.326469e-3*ztt+1.553190)*ztt-65.00517)*ztt+1044.077
         zkw= (((-1.361629e-4*ztt-1.852732e-2)*ztt-30.41638)*ztt+2098.925)*ztt+190925.6
         zk0= (zb1*zsr + za1)*zs + zkw
;
; ...   masked in situ density
         case taille[0] of
            0: zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb)))
            1: zrhop[jk] = zrhop[jk] / (1.0-zh/(zk0-zh*(za-zh*zb)))
            2:BEGIN
               if jpt EQ 1 then zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb))) $
               ELSE zrhop[jk, *] = zrhop[jk, *] / (1.0-zh/(zk0-zh*(za-zh*zb)))
            END
            3:BEGIN
               if jpt EQ 1 then zrhop[*, *,jk] = zrhop[*, *,jk] / (1.0-zh/(zk0-zh*(za-zh*zb))) $
               ELSE zrhop = zrhop / (1.0-zh/(zk0-zh*(za-zh*zb)))
            END
            4: zrhop[*, *,jk, *] = zrhop[*, *,jk, *] / (1.0-zh/(zk0-zh*(za-zh*zb)))
         endcase

      ENDIF
   ENDFOR

   terre = where(tn GE 1e6)
   if terre[0] NE -1 then zrhop[terre] = valmask

   if keyword_set(key_performance) THEN print, 'temps rhon', systime(1)-tempsun

   return, zrhop
END