!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE SFCDIF(LMHK,SM,THS,QS,UZ0,VZ0,THZ0,QZ0 & , USTAR,WSTAR,Z0,ZEFF,AKMS,AKHS,HPBL,CT & , U10,V10,TH02,TH10,Q02,Q10 & ! SM v100m , TH100,Q100,U100,V100 & ! SM v100m , ULM,VLM,T,Q,APE,Z,PD,PT,TLM) ! ****************************************************************** ! * * ! * SURFACE LAYER * ! * * ! ****************************************************************** ! Ammended to use the "Effective roughness" of Mason (1986, see ! Georgelin et al., MWR July 1994), by FM, RW, June 1995 !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- PARAMETER (LP1=LM+1) !----------------------------------------------------------------------- PARAMETER & (WWST=1.2,WWST2=WWST*WWST,G=9.8,USTFC=0.018/G & ,VKRM=0.40,RIC=0.183,RFC=0.191,FHNEU=0.8 & ,RRIC=1.0/RIC,RFAC=RIC/(FHNEU*RFC*RFC),EXCM=0.001 & ,BETA=1./270.,BTG=BETA*G & ,ELFC=VKRM*BTG,CNV=0.608*G/BTG & ,WOLD=.15,WNEW=1.-WOLD,ITRMX=05 & ,PIHF=3.14159265/2.,PIFR=3.14159265/4. & !----------------------------------------------------------------------- ,EPSU2=1.E-4,EPSUST=0.07,EPSIT=1.E-4,EPSA=1.E-8 & ,ZTMIN=-5.,ZTMAX=1. & !----------------------------------------------------------------------- ! M &,SMALL=0.35, GLKBS=30.0,GLKBR=10.0,GRRS=GLKBR/GLKBS , GLKBS=30.0,GLKBR=10.0,GRRS=GLKBR/GLKBS & ! M &,CZIV=SMALL*GLKBS ,VISC=1.5E-5, TVISC=2.1E-5, QVISC=2.1E-5 & ,RVISC=1./VISC,RTVISC=1./TVISC,RQVISC=1./QVISC & ,SQPR=0.84,SQSC=0.84,ZQRZT=SQSC/SQPR & ,USTR=0.225,USTC=0.7 & ! M &,FZU1=CZIV*VISC,FZT1=RVISC *TVISC*SQPR, FZQ1=RTVISC*QVISC*ZQRZT ,FZT1=RVISC *TVISC*SQPR, FZQ1=RTVISC*QVISC*ZQRZT & ! M &, FZT2=CZIV*GRRS*TVISC*SQPR,FZQ2=RTVISC*QVISC*ZQRZT , FZQ2=RTVISC*QVISC*ZQRZT, M=30.0 & !----------------------------------------------------------------------- ,ZTFC=1.0 & ! &,CZIL=.1000,SQVISC=258.2,ZILFC=-CZIL*VKRM*SQVISC ,CZIL=.2000,SQVISC=258.2,ZILFC=-CZIL*VKRM*SQVISC & !!!GSM ,CZIL=.8000,SQVISC=258.2,ZILFC=-CZIL*VKRM*SQVISC & ,PQ0=379.90516,A2=17.2693882,A3=273.16,A4=35.86 & ,CAPA=0.28589641E0,H1M5=1.E-5) !----------------------------------------------------------------------- DIMENSION & T (LM),Q (LM) DIMENSION & APE (LM) & ,Z (LP1) & ! ZEFF-ZEFF-ZEFF-ZEFF ,ZEFF (4) ! ZEFF-ZEFF-ZEFF-ZEFF !----------------------------------------------------------------------- ! morelli COMMON MOMENTO COMMON /MOMENTO/ UMFLX,VMFLX,AKMS10 ! morelli end PSLMU(ZZ)=-0.96*ALOG(1.0-4.5*ZZ) PSLMS(ZZ)=ZZ*RRIC-2.076*(1.-1./(ZZ+1.)) PSLHU(ZZ)=-0.96*ALOG(1.0-4.5*ZZ) PSLHS(ZZ)=ZZ*RFAC-2.076*(1.-1./(ZZ+1.)) PSPMU(XX)=-2.*ALOG((XX+1.)*0.5)-ALOG((XX*XX+1.)*0.5)+2.*ATAN(XX) & -PIHF PSPMS(YY)=5.*YY PSPHU(XX)=-2.*ALOG((XX*XX+1.)*0.5) PSPHS(YY)=5.*YY !*********************************************************************** LMHP=LMHK+1 THLM=T(LMHK)*APE(LMHK) QLM=Q(LMHK) !----------------------------------------------------------------------- Z0=(1.-SM)*Z0+SM*AMAX1(USTFC*USTAR*USTAR,1.59E-5) !--------------VISCOUS SUBLAYER----------------------------------------- IF(SM > 0.5 .AND. USTAR < USTC)THEN !----------------------------------------------------------------------- !--------- Malagutti class experiments------------- Rr= USTAR*Z0*1/VISC SMALL=11/(M*(Rr**0.25)) CZIV=SMALL*GLKBS FZU1=CZIV*VISC FZT2=CZIV*GRRS*TVISC*SQPR ! WRITE(6,*)"SMALL1=" , SMALL !----------------------------------------------------------------------- IF(USTAR < USTR)THEN ZU=FZU1*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR WGHT=AKMS*ZU*RVISC RWGH=WGHT/(WGHT+1.) UZ0=(ULM*RWGH+UZ0)*0.5 VZ0=(VLM*RWGH+VZ0)*0.5 ZT=FZT1*ZU WGHT=AKHS*ZT*RTVISC THZ0=((WGHT*THLM+THS)/(WGHT+1.)+THZ0)*0.5 ZQ=FZQ1*ZT WGHT=AKHS*ZQ*RQVISC QZ0 =((WGHT*QLM+QS)/(WGHT+1.)+QZ0)*0.5 ENDIF IF(USTAR >= USTR .AND. USTAR < USTC)THEN ZU=Z0 UZ0=0. VZ0=0. ZT=FZT2*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR WGHT=AKHS*ZT*RTVISC THZ0=((WGHT*THLM+THS)/(WGHT+1.)+THZ0)*0.5 ZQ=FZQ2*ZT WGHT=AKHS*ZQ*RQVISC QZ0 =((WGHT*QLM+QS)/(WGHT+1.)+QZ0)*0.5 ENDIF !----------------------------------------------------------------------- ELSE !----------------------------------------------------------------------- ZU=Z0 ! ZEFF-ZEFF-ZEFF-ZEFF IF(SM <= 0.5)THEN IF(ULM == 0.) ULM=EPSU2 ALPHA=ABS(ATAN(VLM/ULM)+PIHF-EPSA) X=ALPHA/PIFR ML=1+X ML=MIN(4,ML) MH=1+MOD(ML,4) WLOW=X-ML+1 ZU=WLOW*ZEFF(ML)+(1.-WLOW)*ZEFF(MH) ENDIF ! ZEFF-ZEFF-ZEFF-ZEFF UZ0=0. VZ0=0. ZT=Z0 THZ0=THS ZQ=Z0 QZ0=QS !----------------------------------------------------------------------- ENDIF !----------------------------------------------------------------------- ZSL=(Z(LMHK)-Z(LMHP))*0.5 ! ZEFF-ZEFF-ZEFF-ZEFF ZU=AMIN1(ZU,0.5*ZSL) ! ZEFF-ZEFF-ZEFF-ZEFF RDZ=1./ZSL CXCH=EXCM*RDZ !----------------------------------------------------------------------- IF(SM > 0.5)THEN DTHV=(0.608*QLM+1.)*THLM-(0.608*QZ0+1.)*THZ0 ELSE DTHV=(QLM-QZ0)*CNV+THLM-THZ0 ZT=Z0*ZTFC ENDIF DU2=AMAX1((ULM-UZ0)**2+(VLM-VZ0)**2,EPSU2) !----------------------------------------------------------------------- RIB=BTG*DTHV*ZSL/DU2 !--------------BELJARS CORRECTION OF USTAR------------------------------ BTGH=BTG*HPBL WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) USTAR=AMAX1(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST) !--------- Malagutti class experiments------------- Rr= USTAR*Z0*1/VISC SMALL=11/(M*(Rr**0.25)) CZIV=SMALL*GLKBS FZU1=CZIV*VISC FZT2=CZIV*GRRS*TVISC*SQPR ! WRITE(6,*)"SMALL2=",SMALL ! WRITE(6,*)"ZU2=",ZU,"ZT2=",ZT !--------------ZILITINKEVITCH FIX FOR ZT-------------------------------- IF(SM < 0.5)ZT=EXP(ZILFC*SQRT(USTAR*Z0))*Z0 !----------------------------------------------------------------------- IF(SM > 0.5 .AND. RIB >= RIC)THEN !----------------------------------------------------------------------- AKMS=AMAX1( VISC*RDZ,CXCH) AKHS=AMAX1(TVISC*RDZ,CXCH) !----------------------------------------------------------------------- ELSE !----------------------------------------------------------------------- ZSLU=ZSL+ZU ZSLT=ZSL+ZT RLOGU=ALOG(ZSLU/ZU) RLOGT=ALOG(ZSLT/ZT) RLMO=ELFC*AKHS*DTHV/USTAR**3 !--------------SEA POINTS FIRST ... ------------------------------------ IF(SM > 0.5)THEN DO 100 ITR=1,ITRMX !--------------1./MONIN-OBUKKHOV LENGTH-SCALE--------------------------- ZETALT=AMAX1(ZSLT*RLMO,ZTMIN) RLMO=ZETALT/ZSLT ZETALU=ZSLU*RLMO ZETAU=ZU*RLMO ZETAT=ZT*RLMO !--------------LL FUNCTIONS OVER SEA------------------------------------ IF(RLMO < 0.)THEN PSMZ=PSLMU(ZETAU) SIMM= PSLMU(ZETALU)-PSMZ+RLOGU PSHZ=PSLHU(ZETAT) SIMH=FHNEU*(PSLHU(ZETALT)-PSHZ+RLOGT) ELSE PSMZ=PSLMS(ZETAU) SIMM= PSLMS(ZETALU)-PSMZ+RLOGU PSHZ=PSLHS(ZETAT) SIMH=FHNEU*(PSLHS(ZETALT)-PSHZ+RLOGT) ENDIF !--------------BELJAARS CORRECTION FOR USTAR---------------------------- USTAR=AMAX1(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST) !--------- Malagutti class experiments------------- Rr= USTAR*Z0*1/VISC SMALL=11/(M*(Rr**0.25)) CZIV=SMALL*GLKBS FZU1=CZIV*VISC FZT2=CZIV*GRRS*TVISC*SQPR ! WRITE(6,*)"SMALL3=",SMALL !----------------------------------------------------------------------- USTARK=USTAR*VKRM AKMS=AMAX1(USTARK/SIMM,CXCH) AKHS=AMAX1(USTARK/SIMH,CXCH) !----------------------------------------------------------------------- WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) RLMN=ELFC*AKHS*DTHV/USTAR**3 !----------------------------------------------------------------------- RLMP=RLMO RLMA=RLMO*WOLD+RLMN*WNEW !----------------------------------------------------------------------- ! IF(ABS((RLMN-RLMO)/RLMA).LT.EPSIT) GO TO 110 !----------------------------------------------------------------------- RLMO=RLMA !----------------------------------------------------------------------- 100 END DO !----------------------------------------------------------------------- 110 CONTINUE !--------------END OF SEA POINT PROCESSING------------------------------ ELSE !--------------NOW LAND POINTS ...-------------------------------------- DO 200 ITR=1,ITRMX !--------------1./MONIN-OBUKKHOV LENGTH-SCALE--------------------------- ZETALT=AMAX1(ZSLT*RLMO,ZTMIN) RLMO=ZETALT/ZSLT ZETALU=ZSLU*RLMO ZETAU=ZU*RLMO ZETAT=ZT*RLMO !--------------PAULSON 1970 FUNCTIONS OVER LAND W RAD. SKIN T----------- IF(RLMO < 0.)THEN XLU4=1.-16.*ZETALU XLT4=1.-16.*ZETALT XU4 =1.-16.*ZETAU XT4 =1.-16.*ZETAT XLU=SQRT(SQRT(XLU4)) XLT=SQRT(SQRT(XLT4)) XU =SQRT(SQRT(XU4)) XT =SQRT(SQRT(XT4)) PSMZ=PSPMU(XU) SIMM=PSPMU(XLU)-PSMZ+RLOGU PSHZ=PSPHU(XT) SIMH=PSPHU(XLT)-PSHZ+RLOGT ELSE ZETAU=AMIN1(ZETAU,ZTMAX) ZETAT=AMIN1(ZETAT,ZTMAX) ZETALU=AMIN1(ZETALU,ZTMAX) ZETALT=AMIN1(ZETALT,ZTMAX) PSMZ=PSPMS(ZETAU) SIMM=PSPMS(ZETALU)-PSMZ+RLOGU PSHZ=PSPHS(ZETAT) SIMH=PSPHS(ZETALT)-PSHZ+RLOGT ENDIF !--------------BELJAARS CORRECTION FOR USTAR---------------------------- USTAR=AMAX1(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST) !--------------ZILITINKEVITCH FIX FOR ZT-------------------------------- ZT=EXP(ZILFC*SQRT(USTAR*Z0))*Z0 ZSLT=ZSL+ZT RLOGT=ALOG(ZSLT/ZT) !----------------------------------------------------------------------- USTARK=USTAR*VKRM AKMS=AMAX1(USTARK/SIMM,CXCH) AKHS=AMAX1(USTARK/SIMH,CXCH) !----------------------------------------------------------------------- WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) RLMN=ELFC*AKHS*DTHV/USTAR**3 !----------------------------------------------------------------------- RLMP=RLMO RLMA=RLMO*WOLD+RLMN*WNEW !----------------------------------------------------------------------- ! IF(ABS((RLMN-RLMO)/RLMA).LT.EPSIT) GO TO 210 !----------------------------------------------------------------------- RLMO=RLMA !----------------------------------------------------------------------- 200 END DO !----------------------------------------------------------------------- 210 CONTINUE !--------------END OF LAND POINT PROCESSING AND SEA-LAND BRANCHING------ ENDIF !--------------END OF TURBULENCE-NO TURBULENCE BRANCHING---------------- ENDIF !--------------COUNTERGRADIENT FIX-------------------------------------- ! HV=-AKHS*DTHV ! IF(HV.GT.0.)THEN ! FCT=-10.*(BTG)**(-1./3.) ! CT=FCT*(HV/(HPBL*HPBL))**(2./3.) ! ELSE CT=0. ! ENDIF !--------------DIAGNOSTIC BLOCK----------------------------------------- WSTAR=SQRT(WSTAR2)/WWST UMFLX=AKMS*(ULM -UZ0 ) VMFLX=AKMS*(VLM -VZ0 ) HSFLX=AKHS*(THLM-THZ0) HLFLX=AKHS*(QLM -QZ0 ) !----------------------------------------------------------------------- IF(SM > 0.5 .AND. RIB >= RIC)THEN !----------------------------------------------------------------------- ! p AKMS10=AMAX1( VISC/10.,CXCH) ! p AKHS02=AMAX1(TVISC/02.,CXCH) ! p AKHS10=AMAX1(TVISC/10.,CXCH) AKMS10=AMAX1( VISC/10.,4.*CXCH) ! SM v100m AKMS100=AMAX1( VISC/100.,4.*CXCH) ! SM v100m AKHS02=AMAX1(TVISC/02.,4.*CXCH) AKHS10=AMAX1(TVISC/10.,4.*CXCH) ! SM v100m AKHS100=AMAX1(TVISC/100.,4.*CXCH) ! SM v100m !----------------------------------------------------------------------- ELSE !----------------------------------------------------------------------- ZU10=ZU+10. ! SM v100m ZU100=ZU+100. ! SM v100m ZT02=ZT+02. ZT10=ZT+10. ! SM v100m ZT100=ZT+100. ! SM v100m RLNU10=ALOG(ZU10/ZU) ! SM v100 RLNU100=ALOG(ZU100/ZU) ! SM v100 RLNT02=ALOG(ZT02/ZT) RLNT10=ALOG(ZT10/ZT) ! SM v100 RLNT100=ALOG(ZT100/ZT) ! SM v100m ZTAU10=ZU10*RLMP ! SM v100m ZTAU100=ZU100*RLMP ! SM v100m ZTAT02=ZT02*RLMP ZTAT10=ZT10*RLMP ! SM v100m ZTAT100=ZT100*RLMP ! SM v100m !--------------LL FUNCTIONS OVER SEA------------------------------------ IF(SM > 0.5)THEN !----------------------------------------------------------------------- IF(RLMP < 0.)THEN SIMM10= PSLMU(ZTAU10)-PSMZ+RLNU10 ! SM v100m SIMM100= PSLMU(ZTAU100)-PSMZ+RLNU100 ! SM v100m SIMH02=FHNEU*(PSLHU(ZTAT02)-PSHZ+RLNT02) SIMH10=FHNEU*(PSLHU(ZTAT10)-PSHZ+RLNT10) ! SM v100m SIMH100=FHNEU*(PSLHU(ZTAT100)-PSHZ+RLNT100) ! SM v100m ELSE SIMM10= PSLMS(ZTAU10)-PSMZ+RLNU10 ! SM v100m SIMM100= PSLMS(ZTAU100)-PSMZ+RLNU100 ! SM v100m SIMH02=FHNEU*(PSLHS(ZTAT02)-PSHZ+RLNT02) SIMH10=FHNEU*(PSLHS(ZTAT10)-PSHZ+RLNT10) ! SM v100m SIMH100=FHNEU*(PSLHS(ZTAT100)-PSHZ+RLNT100) ! SM v100m ENDIF !--------------PAULSON 1970 FUNCTIONS OVER LAND W RAD. SKIN T----------- ELSE !----------------------------------------------------------------------- IF(RLMP < 0.)THEN XLU104=1.-16.*ZTAU10 ! SM v100 XLU1004=1.-16.*ZTAU100 ! SM v100 XLT024=1.-16.*ZTAT02 XLT104=1.-16.*ZTAT10 ! SM v100 XLT1004=1.-16.*ZTAT100 ! SM v100 XLU10=SQRT(SQRT(XLU104)) ! SM v100 XLU100=SQRT(SQRT(XLU1004)) ! SM v100 XLT02=SQRT(SQRT(XLT024)) XLT10=SQRT(SQRT(XLT104)) ! SM v100 XLT100=SQRT(SQRT(XLT1004)) ! SM v100 SIMM10=PSPMU(XLU10)-PSMZ+RLNU10 ! SM v100 SIMM100=PSPMU(XLU100)-PSMZ+RLNU100 ! SM v100 SIMH02=PSPHU(XLT02)-PSHZ+RLNT02 SIMH10=PSPHU(XLT10)-PSHZ+RLNT10 ! SM v100 SIMH100=PSPHU(XLT100)-PSHZ+RLNT100 ! SM v100 ELSE ZTAU10=AMIN1(ZTAU10,ZTMAX) ! SM v100m ZTAU100=AMIN1(ZTAU100,ZTMAX) ! SM v100m ZTAT02=AMIN1(ZTAT02,ZTMAX) ZTAT10=AMIN1(ZTAT10,ZTMAX) ! SM v100m ZTAT100=AMIN1(ZTAT100,ZTMAX) ! SM v100m SIMM10=PSPMS(ZTAU10)-PSMZ+RLNU10 ! SM v100m SIMM100=PSPMS(ZTAU100)-PSMZ+RLNU100 ! SM v100m SIMH02=PSPHS(ZTAT02)-PSHZ+RLNT02 SIMH10=PSPHS(ZTAT10)-PSHZ+RLNT10 ! SM v100m SIMH100=PSPHS(ZTAT100)-PSHZ+RLNT100 ! SM v100m ENDIF !----------------------------------------------------------------------- ENDIF !----------------------------------------------------------------------- AKMS10=AMAX1(USTARK/SIMM10,CXCH) ! SM v100m AKMS100=AMAX1(USTARK/SIMM100,CXCH) ! SM v100m AKHS02=AMAX1(USTARK/SIMH02,CXCH) AKHS10=AMAX1(USTARK/SIMH10,CXCH) ! SM v100m AKHS100=AMAX1(USTARK/SIMH100,CXCH) ! SM v100m !----------------------------------------------------------------------- ENDIF !----------------------------------------------------------------------- U10 =UMFLX/AKMS10+UZ0 ! SM v100m U100 =UMFLX/AKMS100+UZ0 V100 =VMFLX/AKMS100+VZ0 ! SM v100m V10 =VMFLX/AKMS10+VZ0 TH02=HSFLX/AKHS02+THZ0 TH10=HSFLX/AKHS10+THZ0 ! SM v100m TH100=HSFLX/AKHS100+THZ0 ! SM v100m ! GSM changed this section in response to problem with 2-m ! dew point occasionally being greater than 2-m temperature ! and similar problem at 10-m. Now, a saturation Q is ! calculated at each level, and the Q is constrained to ! be no higher than the saturation value. PDS=PD+PT TERM1=-0.068283/TLM PSHLTR=PDS*EXP(TERM1) T02=TH02*(PSHLTR*H1M5)**CAPA QSAT2 = PQ0/PSHLTR*EXP(A2*(T02-A3)/(T02-A4)) Q02 =HLFLX/AKHS02+QZ0 IF (Q02 < 0.) THEN IF (QLM > 0.) THEN Q02=QLM ELSE Q02=0.0001 ENDIF ENDIF IF (Q02 > QSAT2)THEN Q02 = QSAT2 ENDIF T10=TH10*(PSHLTR*H1M5)**CAPA QSAT10 = PQ0/PSHLTR*EXP(A2*(T10-A3)/(T10-A4)) Q10 =HLFLX/AKHS10+QZ0 IF (Q10 < 0.) THEN IF (QLM > 0.) THEN Q10=QLM ELSE Q10=0.0001 ENDIF ENDIF IF (Q10 > QSAT10)THEN Q10 = QSAT10 ENDIF ! SM v100m P100=PDS*EXP(-100.0*G/(287.04*TLM)) T100=TH100*(P100*H1M5)**CAPA QSAT100 = PQ0/P100*EXP(A2*(T100-A3)/(T100-A4)) Q100 =HLFLX/AKHS100+QZ0 IF (Q100 < 0.) THEN IF (QLM > 0.) THEN Q100=QLM ELSE Q100=0.0001 ENDIF ENDIF IF (Q100 > QSAT100)THEN Q100 = QSAT100 ENDIF ! SM v100m ! new calculation of 10-m winds !----------------------------------------------------- U10E=U10 V10E=V10 ! SM v100m U100E=U100 V100E=V100 ! SM v100m !----------------------------------------------------- IF(SM < 0.5) THEN ! choose the equivalent z0 here: ! j ZU=0.01 ! m zu=zu*0.1 zuuz=amin1(zu*0.50,0.10) zu=amax1(zu*0.10,zuuz) ZU10=ZU+10. ! SM v100m ZU100=ZU+100. ! SM v100m RLNU10=ALOG(ZU10/ZU) ! SM v100m RLNU100=ALOG(ZU100/ZU) ! SM v100m ZTAU=ZU*RLMP ZTAU10=ZU10*RLMP ! SM v100m ZTAU100=ZU100*RLMP ! SM v100m !-------------------------------------------------------- IF(RLMP < 0)THEN XLU104=1.-16.*ZTAU10 ! SM v100m XLU1004=1.-16.*ZTAU100 ! SM v100m XU104 =1.-16.*ZTAU XLU10=SQRT(SQRT(XLU104)) ! SM v100m XLU100=SQRT(SQRT(XLU1004)) ! SM v100m XU10 =SQRT(SQRT(XU104)) SIMM10=PSPMU(XLU10)-PSPMU(XU10)+RLNU10 ! SM v100m SIMM100=PSPMU(XLU100)-PSPMU(XU10)+RLNU100 ! SM v100m ELSE ZTAU10=AMIN1(ZTAU10,ZTMAX) ! SM v100m ZTAU100=AMIN1(ZTAU100,ZTMAX) ! SM v100m SIMM10=PSPMS(ZTAU10)-PSPMS(ZTAU)+RLNU10 ! SM v100m SIMM100=PSPMS(ZTAU100)-PSPMS(ZTAU)+RLNU100 ! SM v100m ENDIF !----------------------------------------------------- EKMS10=AMAX1(USTARK/SIMM10,CXCH) ! SM v100m EKMS100=AMAX1(USTARK/SIMM100,CXCH) ! SM v100m U10E=UMFLX/EKMS10+UZ0 V10E=VMFLX/EKMS10+VZ0 ! SM v100m U100E=UMFLX/EKMS100+UZ0 V100E=VMFLX/EKMS100+VZ0 ! SM v100m ENDIF !---------------------------------------------------------------- !s.morelll U10=U10E !s.morelli V10=V10E ! SM v100m ! U100=U100E ! V100=V100E ! SM v100m !----------------------------------------------------------------------- RETURN END SUBROUTINE SFCDIF