;+ ; @file_comments ; ; @categories ; ; @param SN ; ; @param TN ; ; @keyword INSITU ; ; @keyword SIGMA_N ; ; @returns ; ; @uses ; ; @restrictions ; ; @examples ; ; @history ; ; @version ; $Id$ ; ;; ;; Calcul de la fonction d'etat (issue de eos.F) ;; ;; Creation : 1997 / G. Roullet ;; adaptation pour les tableaux z,zt,xyz,xyzt ;; par seb. ;; ; @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