C ------------------------------------------------------------------ SUBROUTINE ZTOSIG(ZS,TB,ZZ,H,T,IM,JM,KS,KB) C C VERTICAL INTERPOLATION FROM A Z-GRID TO A SIGMA GRID C DIMENSION ZS(KS),TB(IM,JM,KS),ZZ(KB),H(IM,JM),T(IM,JM,KB), 1 TIN(KS),TOUT(KB),ZZH(KB) DO 40 I=1,IM DO 40 J=1,JM IF(H(I,J).LE.1.0)GO TO 40 C IF(H(I,J).LT.1.00001)GO TO 40 C-- special interp on z-lev for cases of no data because H smoothing DO 45 K=1,KS TIN(K)=TB(I,J,K) IF(ZS(K).LE.H(I,J).AND.TIN(K).LT.0.01)THEN TMAX=AMAX1(TB(I-1,J,K),TB(I+1,J,K),TB(I,J-1,K),TB(I,J+1,K)) TIN(K)=TMAX ENDIF IF(TIN(K).LT.0.01.AND.K.NE.1)TIN(K)=TIN(K-1) 45 CONTINUE C DO 50 K=1,KB 50 ZZH(K)=-ZZ(K)*H(I,J) C C VERTICAL SPLINE INTERP. CALL SPLINC(ZS,TIN,KS ,2.e30,2.e30,ZZH,TOUT,KB) C IPR=IM/2 JPR=JM/2 IF(I.EQ.IPR.AND.J.EQ.JPR) THEN WRITE(6,'(//,'' Data interpolated from z to sigma grid at I,J ='' 1 ,I5,'','',I5)') IPR,JPR WRITE(6,'('' H ='',F10.1)') H(IPR,JPR) WRITE(6,'(1X,I5,4F10.4)') (K,ZS(K),TIN(K),ZZH(K),TOUT(K),K=1,KB) WRITE(6,'(1X,I5,2F10.4)') (K,ZS(K),TIN(K),K=KB+1,KS) ENDIF C T(I,J,:)=TOUT(:) 40 CONTINUE C RETURN END C SUBROUTINE SPLINC(X,Y,N,YP1,YPN,XNEW,YNEW,M) C from "Numerical Recipes" by W.H. Press et al, Cambridge Univerisity Press, 1986. C PARAMETER (NMAX=100) DIMENSION X(N),Y(N),Y2(NMAX),U(NMAX),XNEW(M),YNEW(M) IF (YP1.GT..99E30) THEN Y2(1)=0. U(1)=0. ELSE Y2(1)=-0.5 U(1)=(3./(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1) ENDIF DO 11 I=2,N-1 SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1)) P=SIG*Y2(I-1)+2. Y2(I)=(SIG-1.)/P U(I)=(6.*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1)) * /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*U(I-1))/P 11 CONTINUE IF (YPN.GT..99E30) THEN QN=0. UN=0. ELSE QN=0.5 UN=(3./(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1))) ENDIF Y2(N)=(UN-QN*U(N-1))/(QN*Y2(N-1)+1.) DO 12 K=N-1,1,-1 Y2(K)=Y2(K)*Y2(K+1)+U(K) 12 CONTINUE C DO 20 I =1,M CALL SPLINT(X,Y,Y2,N,XNEW(I),YNEW(I)) 20 CONTINUE RETURN END SUBROUTINE SPLINT(XA,YA,Y2A,N,X,Y) DIMENSION XA(N),YA(N),Y2A(N) KLO=1 KHI=N 1 IF (KHI-KLO.GT.1) THEN K=(KHI+KLO)/2 IF(XA(K).GT.X)THEN KHI=K ELSE KLO=K ENDIF GOTO 1 ENDIF H=XA(KHI)-XA(KLO) IF (H.EQ.0.) CALL CRASH(5,0) A=(XA(KHI)-X)/H B=(X-XA(KLO))/H Y=A*YA(KLO)+B*YA(KHI)+ * ((A**3-A)*Y2A(KLO)+(B**3-B)*Y2A(KHI))*(H**2)/6. RETURN END C ------------------------------------------------------------------