FUNCTION rhon, sn, tn, INSITU = insitu, SIGMA_N = sigma_n @common tempsun = systime(1) ; pour key_performance ;+ ;; ;; Calcul de la fonction d'etat (issue de eos.F) ;; ;; Creation : 1997 / G. Roullet ;; adaptation pour les tableaux z,zt,xyz,xyzt ;; par seb. ;; ;- 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