C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE VDIFQ(LMHK,KTM,DTQ2,Q2,EL,Z) C ****************************************************************** C * * C * VERTICAL DIFFUSION * C * * C ****************************************************************** C----------------------------------------------------------------------- INCLUDE "parmeta" #include "sp.h" C----------------------------------------------------------------------- P A R A M E T E R &(LP1=LM+1,LM1=LM-1,LM2=LM-2) P A R A M E T E R &(ESQ=0.20,ELZ0=0.) C----------------------------------------------------------------------- D I M E N S I O N & Q2 (LM) D I M E N S I O N & EL (LM1) &,Z (LP1) D I M E N S I O N & CM (LM2),CR (LM2),RSQ2 (LM2),AKQ (LM2),DTOZ (LM2) C----------------------------------------------------------------------- C*********************************************************************** DTDIF=DTQ2/FLOAT(KTM) LMHM=LMHK-1 LMH2=LMHK-2 LMHP=LMHK+1 C----------------------------------------------------------------------- DO 300 KT=1,KTM C----------------------------------------------------------------------- DO 100 L=1,LMH2 DTOZ(L)=(DTDIF+DTDIF)/(Z(L)-Z(L+2)) AKQ(L)=SQRT((Q2(L)+Q2(L+1))*0.5)*(EL(L)+EL(L+1))*0.5*ESQ & /(Z(L+1)-Z(L+2)) CR(L)=-DTOZ(L)*AKQ(L) 100 CONTINUE C CM(1)=DTOZ(1)*AKQ(1)+1. RSQ2(1)=Q2(1) C----------------------------------------------------------------------- DO 110 L=2,LMH2 CF=-DTOZ(L)*AKQ(L-1)/CM(L-1) CM(L)=-CR(L-1)*CF+(AKQ(L-1)+AKQ(L))*DTOZ(L)+1. RSQ2(L)=-RSQ2(L-1)*CF+Q2(L) 110 CONTINUE C----------------------------------------------------------------------- DTOZS=(DTDIF+DTDIF)/(Z(LMHM)-Z(LMHP)) AKQS=SQRT((Q2(LMHM)+Q2(LMHK))*0.5)*(EL(LMHM)+ELZ0)*0.5*ESQ & /(Z(LMHK)-Z(LMHP)) C CF=-DTOZS*AKQ(LMH2)/CM(LMH2) C----------------------------------------------------------------------- Q2(LMHM)=(DTOZS*AKQS*Q2(LMHK)-RSQ2(LMH2)*CF+Q2(LMHM)) & /((AKQ(LMH2)+AKQS)*DTOZS-CR(LMH2)*CF+1.) C DO 120 IVI=1,LMH2 L=LMHM-IVI Q2(L)=(-CR(L)*Q2(L+1)+RSQ2(L))/CM(L) 120 CONTINUE C----------------------------------------------------------------------- 300 CONTINUE C----------------------------------------------------------------------- RETURN END