/[MITgcm]/MITgcm/pkg/fizhi/fizhi_turb.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_turb.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.10 by molod, Wed Jul 14 17:31:57 2004 UTC revision 1.11 by molod, Wed Jul 14 21:47:05 2004 UTC
# Line 210  C Set fmu and ed to zero for no backgrou Line 210  C Set fmu and ed to zero for no backgrou
210        real dshdthg(istrip,nlay),dthdthg(istrip,nlay)        real dshdthg(istrip,nlay),dthdthg(istrip,nlay)
211        real dshdshg(istrip,nlay),dthdshg(istrip,nlay)        real dshdshg(istrip,nlay),dthdshg(istrip,nlay)
212        real transth(istrip,nlay), transsh(istrip,nlay)        real transth(istrip,nlay), transsh(istrip,nlay)
       real checktrb(istrip,nlay)  
213    
214        real tc(istrip),td(istrip),qa(istrip)        real tc(istrip),td(istrip),qa(istrip)
215        real swet1(istrip),swet2(istrip),swet3(istrip)        real swet1(istrip),swet2(istrip),swet3(istrip)
# Line 230  C Set fmu and ed to zero for no backgrou Line 229  C Set fmu and ed to zero for no backgrou
229        real qliqmsc(nchp,nlay),fccmsc(nchp,nlay)        real qliqmsc(nchp,nlay),fccmsc(nchp,nlay)
230    
231        integer ndlsm        integer ndlsm
232        parameter ( ndlsm = 1 )        parameter ( ndlsm = 40)
233        real qdiaglsm(nchp,ndlsm)        real qdiaglsm(nchp,ndlsm)
234    
235        integer n,nsecf,nmonf,ndayf        integer n,nsecf,nmonf,ndayf
# Line 331  c ************************************** Line 330  c **************************************
330  c                            Initialization  c                            Initialization
331  c **********************************************************************  c **********************************************************************
332                
 c Zero-out 2m and 10m Couplings  
 c -----------------------------  
       do j = 1,jm  
       do i = 1,im  
        u2m(i,j) = 0.0  
        v2m(i,j) = 0.0  
        t2m(i,j) = 0.0  
        q2m(i,j) = 0.0  
       u10m(i,j) = 0.0  
       v10m(i,j) = 0.0  
       t10m(i,j) = 0.0  
       q10m(i,j) = 0.0  
       enddo  
       enddo  
   
333  c Initialize diagnostic for ground temperature change  c Initialize diagnostic for ground temperature change
334  c ---------------------------------------------------  c ---------------------------------------------------
335        if(idtg.gt.0) then        if(idtg.gt.0) then
# Line 639  c ----------- Line 623  c -----------
623       4 stq10m,istrip,nlay,nymd,nhms,grav,cp,rgas,faceps,virtcon,undef,       4 stq10m,istrip,nlay,nymd,nhms,grav,cp,rgas,faceps,virtcon,undef,
624       5 dshdthg,dshdshg,dthdthg,dthdshg,eturb,dedqa,dedtc,       5 dshdthg,dshdshg,dthdthg,dthdshg,eturb,dedqa,dedtc,
625       6 hsturb,dhsdqa,dhsdtc,transth,transsh,       6 hsturb,dhsdqa,dhsdtc,transth,transsh,
626       7 ctsave,xxsave,yysave,zetasave,xlsave,khsave,qliq,turbfcc,       7 ctsave,xxsave,yysave,zetasave,xlsave,khsave,qliq,turbfcc)
      8 checktrb)  
627    
628        call pastit (qq,tke,istrip,nchp,nchp,nlay,nn)        call pastit (qq,tke,istrip,nchp,nchp,nlay,nn)
629        call pastit (ctsave,ctmt,istrip,nchp,nchp,1,nn)        call pastit (ctsave,ctmt,istrip,nchp,nchp,1,nn)
# Line 880  c*************************************** Line 863  c***************************************
863        call pstbmpit(chfrstr,qdiaglsm(1,2),istrip,nchp,nchp,1,nn)        call pstbmpit(chfrstr,qdiaglsm(1,2),istrip,nchp,nchp,1,nn)
864        call pstbmpit(lats,qdiaglsm(1,3),istrip,nchp,nchp,1,nn)        call pstbmpit(lats,qdiaglsm(1,3),istrip,nchp,nchp,1,nn)
865        call pstbmpit(lons,qdiaglsm(1,4),istrip,nchp,nchp,1,nn)        call pstbmpit(lons,qdiaglsm(1,4),istrip,nchp,nchp,1,nn)
866        call pstbmpit(igrdstr,qdiaglsm(1,5),istrip,nchp,nchp,1,nn)  c     call pstbmpit(igrdstr,qdiaglsm(1,5),istrip,nchp,nchp,1,nn)
867        call pstbmpit(tc,qdiaglsm(1,6),istrip,nchp,nchp,1,nn)        call pstbmpit(tc,qdiaglsm(1,6),istrip,nchp,nchp,1,nn)
868        call pstbmpit(td,qdiaglsm(1,7),istrip,nchp,nchp,1,nn)        call pstbmpit(td,qdiaglsm(1,7),istrip,nchp,nchp,1,nn)
869        call pstbmpit(qa,qdiaglsm(1,8),istrip,nchp,nchp,1,nn)        call pstbmpit(qa,qdiaglsm(1,8),istrip,nchp,nchp,1,nn)
# Line 954  c*************************************** Line 937  c***************************************
937        enddo        enddo
938        enddo        enddo
939    
       if(tprof)then  
        CALL PNTPRF (1,IJALL,nlay,NYMD,NHMS,transth,'TRB T FLUX      ')  
        CALL PNTPRF (1,IJALL,nlay,NYMD,NHMS,transsh,'TRB Q FLUX      ')  
       endif  
   
940  c tendency updates  c tendency updates
941  c ----------------  c ----------------
942        do  l=1,nlay        do  l=1,nlay
# Line 1165  c*************************************** Line 1143  c***************************************
1143       .                  qdiag(1,1,isnow,bi,bj)    ,ijall,1,nn,.false.)       .                  qdiag(1,1,isnow,bi,bj)    ,ijall,1,nn,.false.)
1144    
1145  c**********************************************************************  c**********************************************************************
       IF(Iudiag1.GT.0) then  
       call paste2grd(checktrb,igrd,chfrstr,istrip,nchp,  
      1                   qdiag(1,1,iudiag1,bi,bj),ijall,nlay,nn,.false.)  
       endif  
   
 c**********************************************************************  
1146  c end regions loop  c end regions loop
1147    
1148   2000 continue   2000 continue
# Line 1513  C*************************************** Line 1485  C***************************************
1485        implicit none        implicit none
1486    
1487  C Argument list declarations  C Argument list declarations
1488        integer nn,irun,nlev,ntrace,ntracedim.itrtrb,nhms,nymd        integer nn,irun,nlev,ntrace,ntracedim,itrtrb,nhms,nymd
1489        real TH(irun,NLEV+1),THV(irun,NLEV+1),SH(irun,NLEV+1)        real TH(irun,NLEV+1),THV(irun,NLEV+1),SH(irun,NLEV+1)
1490        real U(irun,NLEV+1),V(irun,NLEV+1),QQ(irun,NLEV)        real U(irun,NLEV+1),V(irun,NLEV+1),QQ(irun,NLEV)
1491        real PL(irun,NLEV),PLE(irun,NLEV+1),PLK(irun,NLEV)        real PL(irun,NLEV),PLE(irun,NLEV+1),PLK(irun,NLEV)
# Line 1521  C Argument list declarations Line 1493  C Argument list declarations
1493        integer IWATER(irun)        integer IWATER(irun)
1494        real Z0(irun)        real Z0(irun)
1495        real tracers(irun,nlev+1,ntracedim)        real tracers(irun,nlev+1,ntracedim)
1496        real KMBG,KHBG        real dtau,KMBG,KHBG
1497        LOGICAL QBEG,TPROF        LOGICAL QBEG,TPROF
1498          real SWINDS(irun)
1499          real SRI(irun,nlev), ET(irun,nlev)
1500          real EU (irun,nlev)
1501          real WU(irun,nlev)
1502          real WV (irun,nlev), pbldpth(irun)
1503          real sustar(irun), sz0(irun)
1504          real freqdg(irun,nlev-1)
1505          real sct(irun), scu(irun)
1506          real stu2m(irun),stv2m(irun),stt2m(irun),stq2m(irun)
1507          real stu10m(irun),stv10m(irun),stt10m(irun),stq10m(irun)
1508          real grav,cp,rgas,faceps,virtcon,undef
1509        real eturb(irun),dedqa(irun),dedtc(irun)        real eturb(irun),dedqa(irun),dedtc(irun)
1510        real hsturb(irun),dhsdqa(irun),dhsdtc(irun)        real hsturb(irun),dhsdqa(irun),dhsdtc(irun)
1511        real dshdthg(irun,nlev),dthdthg(irun,nlev)        real dshdthg(irun,nlev),dthdthg(irun,nlev)
# Line 1532  C Argument list declarations Line 1515  C Argument list declarations
1515        real zetasave(irun),xlsave(irun,nlev),khsave(irun,nlev)        real zetasave(irun),xlsave(irun,nlev),khsave(irun,nlev)
1516        real qliq(irun,nlev),turbfcc(irun,nlev)        real qliq(irun,nlev),turbfcc(irun,nlev)
1517    
1518  C  C Local Variables
1519        real b1,b3,alpha,halpha,qqmin,qbustr        real b1,b3,alpha,halpha,qqmin,qbustr
1520        PARAMETER ( B1      =   16.6    )          PARAMETER ( B1      =   16.6    )  
1521        PARAMETER ( B3      = 1. / B1  )          PARAMETER ( B3      = 1. / B1  )  
# Line 1547  C Line 1530  C
1530        PARAMETER ( B2    =  10.1 )        PARAMETER ( B2    =  10.1 )
1531        PARAMETER ( two   =   2.0 )        PARAMETER ( two   =   2.0 )
1532    
1533  C Diagnostic Variables        real AHS (irun), HS(irun)
1534  C --------------------        real XX  (irun), YY(irun), CU(irun)
1535        DIMENSION SWINDS(irun)        real CT(irun),  USTAR(irun)
1536        DIMENSION    SRI(irun,nlev), ET(irun,nlev)        real RIB(irun),   ZETA(irun), WS(irun)
1537        DIMENSION    EU (irun,nlev)        real DTHS(irun), DELTHS(irun)
1538        DIMENSION    WU(irun,nlev)        real DTHL(irun), DELTHL(irun)
1539        DIMENSION    WV (irun,nlev), pbldpth(irun)        real RIBIN(irun),CUIN(irun)
1540        DIMENSION sustar(irun),          sz0(irun)        real CTIN(irun),ZETAIN(irun)
1541        DIMENSION    sct(irun),          scu(irun)        real USTARIN(irun),RHOSIN(irun),Z0IN(irun)
1542        dimension stu2m(irun),stv2m(irun),stt2m(irun),stq2m(irun)        real qqcolmin(irun),qqcolmax(irun),levpbl(irun)
1543        dimension stu10m(irun),stv10m(irun),  
1544       1                              stt10m(irun),stq10m(irun)        real ADZ1(irun,nlev), DZ1TMP(irun,nlev)
1545        DIMENSION freqdg(irun,nlev-1)        real DZ3(irun,nlev), TEMP(irun,nlev)
1546          real DV(irun,nlev), DTHV(irun,nlev)
1547  C Dynamic Variables        real DPK(irun,nlev), STRT(irun,nlev)
1548  C -----------------        real DW2(irun,nlev), RI(irun,nlev)
1549        DIMENSION AHS (irun), HS(irun)        real RHOZPK(irun,nlev), Q(irun,nlev)
1550        DIMENSION XX  (irun), YY(irun), CU(irun)        real RIINIT(irun,nlev), DU(irun,nlev)
1551        DIMENSION CT     (irun),  USTAR(irun)        real QQINIT(irun,nlev), RHOKDZ(irun,nlev)
1552        DIMENSION RIB    (irun),   ZETA(irun), WS(irun)        real RHODZ2(irun,nlev)
1553        DIMENSION DTHS   (irun), DELTHS(irun)        REAL KM(irun,nlev), KH(irun,nlev)
1554        DIMENSION DTHL   (irun), DELTHL(irun)  
1555        DIMENSION TG     (irun)        real DELTH  (irun,nlev+1), DELSH (irun,nlev+1)
1556        DIMENSION RIBIN  (irun),   CUIN(irun)        real FLXFAC (irun,nlev+1)
1557        DIMENSION CTIN   (irun), ZETAIN(irun)        real FLXFPK (irun,nlev+1)
1558        DIMENSION USTARIN(irun), RHOSIN(irun), Z0IN(irun)  
1559        DIMENSION    TMP1(irun),   TMP2(irun)        real ADZ2   (irun,nlev-1), RHODZ1(irun,nlev-1)
1560        DIMENSION    TMP3(irun),  ITMP1(irun)        real VKZE   (irun,nlev-1), VKZM  (irun,nlev-1)
1561        DIMENSION   ITMP2(irun)        real XL     (irun,nlev-1), QXLM  (irun,nlev-1)
1562        dimension qqcolmin(irun),qqcolmax(irun),levpbl(irun)        real QQE    (irun,nlev-1), QE    (irun,nlev-1)
1563          real P3     (irun,nlev-1), XQ    (irun,nlev-1)
1564  C Dynamic Variables        real XLDIAG (irun,nlev-1), FLXFCE(irun,nlev-1)
 C -----------------  
       DIMENSION ADZ1   (irun,nlev  ), DZ1TMP(irun,nlev)  
       DIMENSION DZ3    (irun,nlev  ), TEMP  (irun,nlev)  
       DIMENSION DV     (irun,nlev  ), DTHV  (irun,nlev)  
       DIMENSION DPK    (irun,nlev  ), STRT  (irun,nlev)  
       DIMENSION DW2    (irun,nlev  ), RI    (irun,nlev)  
       DIMENSION RHOZPK (irun,nlev  ), Q     (irun,nlev)  
       DIMENSION RIINIT (irun,nlev  ), DU    (irun,nlev)  
       DIMENSION QQINIT (irun,nlev  ), RHOKDZ(irun,nlev)  
       DIMENSION RHODZ2 (irun,nlev  )  
       REAL      KM     (irun,nlev  ),     KH(irun,nlev)  
   
 C Dynamic Variables  
 C -----------------  
       DIMENSION DELTH  (irun,nlev+1), DELSH (irun,nlev+1)  
       DIMENSION FLXFAC (irun,nlev+1), DTHG  (irun,nlev+1)  
       DIMENSION FLXFPK (irun,nlev+1)  
   
 C Dynamic Variables  
 C -----------------  
       DIMENSION ADZ2   (irun,nlev-1), RHODZ1(irun,nlev-1)  
       DIMENSION VKZE   (irun,nlev-1), VKZM  (irun,nlev-1)  
       DIMENSION XL     (irun,nlev-1), QXLM  (irun,nlev-1)  
       DIMENSION QQE    (irun,nlev-1), QE    (irun,nlev-1)  
       DIMENSION P3     (irun,nlev-1), XQ    (irun,nlev-1)  
       DIMENSION XLDIAG (irun,nlev-1), FLXFCE(irun,nlev-1)  
1565    
1566        LOGICAL FIRST,LAST        LOGICAL FIRST,LAST
1567        DIMENSION IBITSTB(irun,nlev),IBITSTR(irun),INTQ(irun,nlev)        integer IBITSTB(irun,nlev),INTQ(irun,nlev)
1568    
1569  C arrays for use by moist bouyancy calculation  C arrays for use by moist bouyancy calculation
1570  C -----------------  C -----------------
# Line 1622  C ----------------- Line 1579  C -----------------
1579        real BETAL(irun,NLEV),BETAT1(irun,NLEV)        real BETAL(irun,NLEV),BETAT1(irun,NLEV)
1580        real BETAW1(irun,NLEV),SBAR(irun,NLEV)        real BETAW1(irun,NLEV),SBAR(irun,NLEV)
1581        real SHSAT(irun,NLEV)        real SHSAT(irun,NLEV)
       real TEMPOR(irun,NLEV)  
1582    
1583  C Some space for variables to be used in called routines  C Some space for variables to be used in called routines
1584        logical LWATER        logical LWATER
1585        integer IVBITRIB(irun)        integer IVBITRIB(irun)
1586        DIMENSION VHZ(irun)        real VHZ(irun)
1587        DIMENSION VH0(irun)        real VH0(irun)
1588        DIMENSION VPSIM(irun),VAPSIM(irun)        real VPSIM(irun),VAPSIM(irun)
1589        DIMENSION VPSIG(irun),VPSIHG(irun)        real VPSIG(irun),VPSIHG(irun)
1590        DIMENSION VTEMP(irun),VDZETA(irun)        real VTEMP(irun),VDZETA(irun)
1591        DIMENSION VDZ0(irun),VDPSIM(irun)        real VDZ0(irun),VDPSIM(irun)
1592        DIMENSION VDPSIH(irun),VZH(irun)        real VDPSIH(irun),VZH(irun)
1593        DIMENSION VXX0(irun),VYY0(irun)        real VXX0(irun),VYY0(irun)
1594        DIMENSION VAPSIHG(irun),VRIB1(irun),VWS1(irun)        real VAPSIHG(irun),VRIB1(irun),VWS1(irun)
1595        DIMENSION VPSIH(irun),VZETAL(irun)        real VPSIH(irun),VZETAL(irun)
1596        DIMENSION VZ0L(irun),VPSIH2(irun)        real VZ0L(irun),VPSIH2(irun)
1597        DIMENSION VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)        real VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)
1598        DIMENSION VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)        real VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)
1599        DIMENSION VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)        real VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)
1600        DIMENSION VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)        real VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)
1601        DIMENSION VXNUM(irun),VDZETA1(irun),VDZETA2(irun)        real VXNUM(irun),VDZETA1(irun),VDZETA2(irun)
1602        DIMENSION VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)        real VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)
1603        DIMENSION VDPSIMC(irun),VDPSIHC(irun)        real VDPSIMC(irun),VDPSIHC(irun)
1604        integer types(irun)  
1605        character*40 name        real DZITRP(irun,nlev-1),STBFCN(irun,nlev)
1606          real XL0(irun,nlev),Q1(irun,nlev-1)
1607        DIMENSION DZITRP(irun,nlev-1), STBFCN(irun,nlev)        real WRKIT1(irun,nlev-1)
1608        DIMENSION    XL0(irun,nlev),       Q1(irun,nlev-1)        real WRKIT2(irun,nlev-1)
1609        DIMENSION WRKIT1(irun,nlev-1)        real WRKIT3(irun,nlev-1)
1610        DIMENSION WRKIT2(irun,nlev-1)        real WRKIT4(irun,nlev-1)
       DIMENSION WRKIT3(irun,nlev-1)  
       DIMENSION WRKIT4(irun,nlev-1)  
1611        INTEGER INT1(irun,nlev), INT2(irun,nlev-1)        INTEGER INT1(irun,nlev), INT2(irun,nlev-1)
1612    
1613        real vrt1con,pi,rsq2pi,p5sr,clh        real vrt1con,pi,rsq2pi,p5sr,clh,vk,rvk,aitr,gbycp,fac1,fac2
1614        integer nt        real getcon,dum,errf
1615          integer istnlv,nlevm1,nlevm2,nlevml,nlevp1,istnm1,istnm2,istnp1
1616          integer istnml,istnmq,istlmq,nlevmq
1617          integer i,iter,init,n,nt,LL,L,Lp,Lp1,lmin,lminq,lminq1,ibit
1618    
1619        vk = getcon('VON KARMAN')        vk = getcon('VON KARMAN')
1620        rvk = 1./vk        rvk = 1./vk
# Line 1677  C Some space for variables to be used in Line 1634  C Some space for variables to be used in
1634        P5SR = 0.5**0.5        P5SR = 0.5**0.5
1635        CLH = GETCON('LATENT HEAT COND') / CP        CLH = GETCON('LATENT HEAT COND') / CP
1636    
 C CALL POINT BY POINT DIAGNOSTIC ROUTINE FOR 'BEFORE' VALUES  
 C ----------------------------------------------------------  
       IF(TPROF) THEN  
       do i = 1,irun  
        types(i) = 1  
       enddo  
       name = 'mid pressure'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,pl)  
       name = 'edge pressure'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,ple)  
       name = 'mid p ** kappa'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,plke)  
       name = 'edge p ** kappa'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,plke)  
       name = 'theta before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,th)  
       name = 'theta virtual before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,thv)  
       name = 'q before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,sh)  
       name = 'u wind before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,u)  
       name = 'v wind before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,V)  
       name = 'heat cap ground'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,hcapg)  
       name = 'latent heat at ground'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,clhg)  
       name = 'net surface rad'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,radflx)  
       name = 'background heat transfer'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,khbg)  
       ENDIF  
1637  C SET INITIAL NUMBER OF ITERATIONS OF SFCFLX  C SET INITIAL NUMBER OF ITERATIONS OF SFCFLX
1638  C ------------------------------------------  C ------------------------------------------
1639        N = 6        N = 6
# Line 2469  C Line 2393  C
2393         WV(I,1) =  WV(I,1) * AITR         WV(I,1) =  WV(I,1) * AITR
2394  9194  CONTINUE  9194  CONTINUE
2395  C  C
 C  IF TPROF, CALL POINT BY POINT DIAGNOSTIC ROUTINE FOR 'AFTER' VALUES  
 C  
        IF(TPROF)THEN  
       name = 'tke before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,qqinit)  
       name = 'richardson number before'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,riinit)  
       name = 'theta after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,th)  
       name = 'theta virtual after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,thv)  
       name = 'q after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev+1,name,sh)  
       name = 'u wind after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,u)  
       name = 'v wind after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,V)  
       name = 'tke after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,qq)  
       name = 'richardson number after'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,ri)  
       name = 'trb u flux'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,wu)  
       name = 'trb v flux'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,wv)  
       name = 'trb t flux'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,wt)  
       name = 'trb q flux'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,wsh)  
       name = 'eddy coef mom'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,eu)  
       name = 'eddy coef heat'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,et)  
       name = 'length scale'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,xldiag)  
       name = 'layer heights'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,nlev,name,dz1tmp)  
       name = 'q ground'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,shg)  
       name = 'rib initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,ribin)  
       name = 'cu initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,cuin)  
       name = 'ct initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,ctin)  
       name = 'ustar initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,ustarin)  
       name = 'rho sfc initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,rhosin)  
       name = 'z0 initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,z0in)  
       name = 'zeta initial'  
       call pntprf(irun,irun,lons,lats,types,nymd,nhms,1,name,zetain)  
        ENDIF  
2396        RETURN        RETURN
2397        END        END
2398         SUBROUTINE SFCFLX(NN,VUS,VVS,VTHV1,VTHV2,VTH1,VTH2,VSH1,         SUBROUTINE SFCFLX(NN,VUS,VVS,VTHV1,VTHV2,VTH1,VTH2,VSH1,
# Line 2577  C    CU            -         MOMENTUM TR Line 2447  C    CU            -         MOMENTUM TR
2447  C    CT            -         HEAT TRANSPORT COEFFICIENT  C    CT            -         HEAT TRANSPORT COEFFICIENT
2448  C  C
2449  C**********************************************************************  C**********************************************************************
2450  C        implicit none
2451    
2452    C Argument List Declarations
2453          integer nn,n,irun
2454          real aitr,cp,rgas,undef
2455          real VUS(IRUN),VVS(IRUN),VTHV1(IRUN),VTHV2(IRUN)
2456          real VTH1(IRUN),VTH2(IRUN),VSH1(IRUN),VSH2(IRUN)
2457          real VPK(IRUN),VPKE(IRUN),VPE(IRUN)
2458          real VZ0(IRUN),VHS(IRUN),VAHS(IRUN)
2459          integer IVWATER(IRUN)
2460          LOGICAL FIRST,LAST
2461          real VRHO(IRUN),VRHOZPK(IRUN)
2462          real VKM(IRUN),VKH(IRUN),VUSTAR(IRUN),VXX(IRUN)
2463          real VYY(IRUN),VCU(IRUN),VCT(IRUN),VRIB(IRUN)
2464          real VZETA(IRUN),VWS(IRUN)
2465          real stu2m(irun),stv2m(irun),stt2m(irun),stq2m(irun)
2466          real stu10m(irun),stv10m(irun),stt10m(irun),stq10m(irun)
2467          LOGICAL LWATER
2468          integer IVBITRIB(irun)
2469          real VHZ(irun),VPSIM(irun),VAPSIM(irun),VPSIG(irun),VPSIHG(irun)
2470          real VTEMP(irun),VDZETA(irun),VDZ0(irun),VDPSIM(irun)
2471          real VDPSIH(irun),VZH(irun),VXX0(irun),VYY0(irun)
2472          real VAPSIHG(irun),VRIB1(irun),VWS1(irun)
2473          real VPSIH(irun),VZETAL(irun),VZ0L(irun),VPSIH2(irun),VH0(irun)
2474          real VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)
2475          real VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)
2476          real VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)
2477          real VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)
2478          real VXNUM(irun),VDZETA1(irun),VDZETA2(irun)
2479          real VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)
2480          real VDPSIMC(irun),VDPSIHC(irun)
2481    
2482    C Local Variables
2483          real USTMX3,USTZ0S,Z0MIN,H0BYZ0,USTH0S,H0VEG,Z0VEGM,PRFAC
2484          real XPFAC,DIFSQT
2485        PARAMETER ( USTMX3 =   0.0632456)        PARAMETER ( USTMX3 =   0.0632456)
2486        PARAMETER ( USTZ0S =   0.2030325E-5)        PARAMETER ( USTZ0S =   0.2030325E-5)
2487        PARAMETER ( Z0MIN  =  USTZ0S/USTMX3)        PARAMETER ( Z0MIN  =  USTZ0S/USTMX3)
# Line 2590  C Line 2493  C
2493        PARAMETER ( XPFAC  = .55        )          PARAMETER ( XPFAC  = .55        )  
2494        PARAMETER ( DIFSQT  = 3.872983E-3)        PARAMETER ( DIFSQT  = 3.872983E-3)
2495    
2496         DIMENSION VUS(IRUN),VVS(IRUN),VTHV1(IRUN),VTHV2(IRUN)        real psihdiag(irun),psimdiag(irun)
2497         DIMENSION VTH1(IRUN),VTH2(IRUN),VSH1(IRUN),VSH2(IRUN)        real getcon,vk,rvk,vk2,bmdl
2498         DIMENSION VPK(IRUN),VPKE(IRUN),VPE(IRUN)        integer iwater,itype
2499         DIMENSION VZ0(IRUN),IVWATER(IRUN),VHS(IRUN),VAHS(IRUN)        integer i,iter
        DIMENSION VRHO(IRUN),VRHOZPK(IRUN)  
        DIMENSION VKM(IRUN),VKH(IRUN),VUSTAR(IRUN),VXX(IRUN)  
        DIMENSION VYY(IRUN),VCU(IRUN),VCT(IRUN),VRIB(IRUN)  
        DIMENSION VZETA(IRUN),VWS(IRUN)  
        dimension stu2m(irun),stv2m(irun),stt2m(irun),stq2m(irun)  
        dimension stu10m(irun),stv10m(irun),stt10m(irun),stq10m(irun)  
        LOGICAL FIRST,LAST  
        LOGICAL LWATER  
        integer IVBITRIB(irun)  
 C  
        DIMENSION VHZ(irun)  
        DIMENSION VH0(irun)  
        DIMENSION VPSIM(irun),VAPSIM(irun)  
        DIMENSION VPSIG(irun),VPSIHG(irun)  
        DIMENSION VTEMP(irun),VDZETA(irun)  
        DIMENSION VDZ0(irun),VDPSIM(irun)  
        DIMENSION VDPSIH(irun),VZH(irun)  
        DIMENSION VXX0(irun),VYY0(irun)  
        DIMENSION VAPSIHG(irun),VRIB1(irun),VWS1(irun)  
        DIMENSION VPSIH(irun),VZETAL(irun)  
        DIMENSION VZ0L(irun),VPSIH2(irun)  
        DIMENSION VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)  
        DIMENSION VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)  
        DIMENSION VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)  
        DIMENSION VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)  
        DIMENSION VXNUM(irun),VDZETA1(irun),VDZETA2(irun)  
        DIMENSION VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)  
        DIMENSION VDPSIMC(irun),VDPSIHC(irun)  
   
        dimension psihdiag(irun),psimdiag(irun)  
2500  C  C
2501        vk = getcon('VON KARMAN')        vk = getcon('VON KARMAN')
2502        rvk = 1./vk        rvk = 1./vk
# Line 2960  C                  (IFLAG=3), OR BOTH (I Line 2833  C                  (IFLAG=3), OR BOTH (I
2833  C     N     -  LENGTH OF VECTOR TO BE SOLVED  C     N     -  LENGTH OF VECTOR TO BE SOLVED
2834  C  C
2835  C**********************************************************************  C**********************************************************************
2836  C        implicit none
2837        DIMENSION PHIM(N),PHIH(N),Z(N)  
2838        DIMENSION INT72(N), INTMAX(N)  C Argument List Declarations
2839        DIMENSION ZSTAR(N),I1(N),I2(N)        integer n,iflag
2840        DIMENSION E1(N),E2(N),TEMP1(N)        real PHIM(N),PHIH(N),Z(N)
2841  C  
2842        DIMENSION PHIM0(385),ZLINM1(75),ZLINM2(75),ZLINM3(36)  C Local Variables
2843        DIMENSION ZLOGM1(74),ZLOGM2(75),ZLOGM3(50)        integer I1(N),I2(N)
2844        DIMENSION PHIH0(385),ZLINH1(75),ZLINH2(75),ZLINH3(36)        real ZSTAR(N),E1(N),E2(N),TEMP1(N)
2845        DIMENSION ZLOGH1(74),ZLOGH2(75),ZLOGH3(50)  C
2846          real PHIM0(385),ZLINM1(75),ZLINM2(75),ZLINM3(36)
2847          real ZLOGM1(74),ZLOGM2(75),ZLOGM3(50)
2848          real PHIH0(385),ZLINH1(75),ZLINH2(75),ZLINH3(36)
2849          real ZLOGH1(74),ZLOGH2(75),ZLOGH3(50)
2850        EQUIVALENCE (PHIM0(1),ZLINM1(1)),(PHIM0(76),ZLINM2(1))        EQUIVALENCE (PHIM0(1),ZLINM1(1)),(PHIM0(76),ZLINM2(1))
2851        EQUIVALENCE (PHIM0(151),ZLINM3(1))        EQUIVALENCE (PHIM0(151),ZLINM3(1))
2852        EQUIVALENCE (PHIM0(187),ZLOGM1(1)),(PHIM0(261),ZLOGM2(1))        EQUIVALENCE (PHIM0(187),ZLOGM1(1)),(PHIM0(261),ZLOGM2(1))
# Line 3148  C Line 3025  C
3025       &  0.664746,0.663985,0.663227,0.662473,0.661723,       &  0.664746,0.663985,0.663227,0.662473,0.661723,
3026       &  0.660977,0.660234,0.659495,0.658759,0.658027,       &  0.660977,0.660234,0.659495,0.658759,0.658027,
3027       &  0.657298/       &  0.657298/
3028    
3029          integer ibit1,ibit2,i
3030  C  C
3031        IBIT1 = 0        IBIT1 = 0
3032        IBIT2 = 0        IBIT2 = 0
# Line 3254  C  SUBPROGRAMS NEEDED Line 3133  C  SUBPROGRAMS NEEDED
3133  C     PHI  -  COMPUTES SIMILARITY FUNCTION FOR MOMENTUM AND SCALARS  C     PHI  -  COMPUTES SIMILARITY FUNCTION FOR MOMENTUM AND SCALARS
3134  C  C
3135  C**********************************************************************  C**********************************************************************
3136  C        implicit none
3137  C  
3138    C Argument List Declarations
3139          integer irun,iflag
3140          real VZZ(IRUN),VZH(IRUN),VPSIM(IRUN),VPSIH(IRUN),
3141         1     VX(IRUN),VXS(IRUN),VY(IRUN),VYS(IRUN)
3142    
3143    C Local Variables
3144          real ZWM,RZWM,Z0M,ZCM,RZCM,CM1,CM2,CM6,CM7,CM8ARG,YCM
3145        PARAMETER ( ZWM     =    1.    )        PARAMETER ( ZWM     =    1.    )
3146        PARAMETER ( RZWM    =  1./ZWM  )        PARAMETER ( RZWM    =  1./ZWM  )
3147        PARAMETER ( Z0M     =    0.2    )        PARAMETER ( Z0M     =    0.2    )
# Line 3268  C Line 3154  C
3154        PARAMETER ( CM8ARG  =  CM7*ZCM*RZWM / (CM2+ZCM)  )        PARAMETER ( CM8ARG  =  CM7*ZCM*RZWM / (CM2+ZCM)  )
3155        PARAMETER ( YCM     =  6. / ( 1. + 6.*CM1*ZCM )  )        PARAMETER ( YCM     =  6. / ( 1. + 6.*CM1*ZCM )  )
3156    
3157        DIMENSION VZZ(IRUN),VZH(IRUN),VPSIM(IRUN),VPSIH(IRUN),        integer INTSTB(irun),INTZ0(irun)
3158       1     VX(IRUN),VXS(IRUN),VY(IRUN),VYS(IRUN)        real ZZ0(irun),Z(irun),Z2(irun),Z1(irun),Z0(irun)
3159          real X0(irun),X1(irun),Y0(irun),Y1(irun)
3160        DIMENSION INTSTB(irun),INT72(irun),INTZ0(irun)        real PSI2(irun),TEMP(irun)
3161        DIMENSION  ZZ0(irun),Z(irun),Z2(irun),Z1(irun),Z0(irun)        real HZ(irun),ARG0(irun),ARG1(irun),DX(irun)
3162        DIMENSION  X0(irun),X1(irun),Y0(irun),Y1(irun)        real X0NUM(irun),X1NUM(irun),X0DEN(irun)
3163        DIMENSION  XX(irun),XXS(irun),YY(irun),YYS(irun)        real X1DEN(irun),Y1DEN(irun),Z2ZWM(irun)
3164        DIMENSION  PSIMM(irun),PSIHH(irun)        real cm3,cm4,cm5,cm8
3165        DIMENSION  PSI2(irun),TEMP(irun)        integer ibit,index
3166        DIMENSION  HZ(irun),ARG0(irun),ARG1(irun),DX(irun)        integer i
       DIMENSION  X0NUM(irun),X1NUM(irun),X0DEN(irun)  
       DIMENSION  X1DEN(irun),Y1DEN(irun),Z2ZWM(irun)  
3167  C  C
3168        CM3 =   sqrt( 0.2/CM1-0.01 )        CM3 =   sqrt( 0.2/CM1-0.01 )
3169        CM4 =   1./CM3        CM4 =   1./CM3
# Line 3568  C Line 3452  C
3452  C     TRBITP -  INTERPOLATES TO HEIGHT WHERE RI = RICR  C     TRBITP -  INTERPOLATES TO HEIGHT WHERE RI = RICR
3453  C  C
3454  C**********************************************************************  C**********************************************************************
3455  C        implicit none
3456  C  
3457    C Argument List Declarations
3458          integer irun,nlev,init,lmin,lminq,lminq1
3459          real cp
3460          real STRT(irun,NLEV),DW2(irun,NLEV),DZ3(irun,NLEV)
3461          real Q(irun,NLEV),VKZM(irun,NLEV-1),VKZE(irun,NLEV-1)
3462          real DTHV(irun,NLEV),DPK(irun,NLEV),DU(irun,NLEV)
3463          real DV(irun,NLEV)
3464          real QXLM(irun,NLEV-1),XL(irun,NLEV-1)
3465          real DZITRP(irun,nlev-1),STBFCN(irun,nlev)
3466          real XL0(irun,nlev),Q1(irun,nlev-1)
3467          real WRKIT1(irun,nlev-1),WRKIT2(irun,nlev-1)
3468          real WRKIT3(irun,nlev-1)
3469          real WRKIT4(irun,nlev-1)
3470          INTEGER INT1(irun,nlev), INT2(irun,nlev-1)
3471    
3472    C Local Variables
3473          real rf1,rf2,e5,d4,d1,rfc,ricr,alpha,dzcnv,xl0cnv,xl0min
3474          real clmt,clmt53
3475        PARAMETER ( RF1     = 0.2340678 )        PARAMETER ( RF1     = 0.2340678 )
3476        PARAMETER ( RF2     = 0.2231172 )        PARAMETER ( RF2     = 0.2231172 )
3477        PARAMETER ( E5      = 49.66     )          PARAMETER ( E5      = 49.66     )  
# Line 3583  C Line 3485  C
3485        PARAMETER ( XL0MIN  = 1.        )        PARAMETER ( XL0MIN  = 1.        )
3486        PARAMETER ( CLMT    = 0.23      )          PARAMETER ( CLMT    = 0.23      )  
3487        PARAMETER ( CLMT53  = 5. * CLMT / 3. )        PARAMETER ( CLMT53  = 5. * CLMT / 3. )
3488    
3489          integer ibit,nlevm1,nlevp1,istnlv,istnm1,nlevml,istnml,Lp1
3490        DIMENSION STRT(irun,NLEV),   DW2(irun,NLEV), DZ3(irun,NLEV)        integer istnmq,istlmq,lminp,lm1,lmin1
3491        DIMENSION DTHV(irun,NLEV),   DPK(irun,NLEV),  DU(irun,NLEV)        integer i,L,LL
       DIMENSION   DV(irun,NLEV),     Q(irun,NLEV)  
       DIMENSION VKZM(irun,NLEV-1),VKZE(irun,NLEV-1)  
       DIMENSION QXLM(irun,NLEV-1),  XL(irun,NLEV-1)  
       DIMENSION DZITRP(irun,nlev-1), STBFCN(irun,nlev)  
       DIMENSION    XL0(irun,nlev),       Q1(irun,nlev-1)  
       DIMENSION WRKIT1(irun,nlev-1)  
       DIMENSION WRKIT2(irun,nlev-1)  
       DIMENSION WRKIT3(irun,nlev-1)  
       DIMENSION WRKIT4(irun,nlev-1)  
 C  
       INTEGER INT1(irun,nlev), INT2(irun,nlev-1)  
3492  C  C
3493        NLEVM1 = NLEV - 1        NLEVM1 = NLEV - 1
3494        NLEVP1 = NLEV + 1        NLEVP1 = NLEV + 1
# Line 3801  C     ------- Line 3692  C     -------
3692  C    DZITRP        -         INTERPOLATION COEFFICIENT  C    DZITRP        -         INTERPOLATION COEFFICIENT
3693  C  C
3694  C**********************************************************************  C**********************************************************************
3695  C        implicit none
3696  C  
3697    C Argument List Declarations
3698          integer irun,nlev
3699          real cp
3700          real STBFCN(irun,NLEV+1)
3701          integer INTCHG(irun,NLEV)
3702          real DTHV(irun,NLEV+1),DPK(irun,NLEV+1)
3703          real DU(irun,NLEV+1),DV(irun,NLEV+1)
3704          real DZITRP(irun,NLEV+1)
3705          real AAA(irun,NLEV),BBB(irun,NLEV)
3706          real CCC(irun,NLEV),DDD(irun,NLEV)
3707    
3708    C Local Variables
3709          real rf1,rf2,e5,d4,d1,rfc,ricr
3710        PARAMETER ( RF1     = 0.2340678 )        PARAMETER ( RF1     = 0.2340678 )
3711        PARAMETER ( RF2     = 0.2231172 )        PARAMETER ( RF2     = 0.2231172 )
3712        PARAMETER ( E5      = 49.66     )          PARAMETER ( E5      = 49.66     )  
# Line 3811  C Line 3715  C
3715        PARAMETER ( RFC     = 0.1912323 )        PARAMETER ( RFC     = 0.1912323 )
3716        PARAMETER ( RICR    = ( (RF1-RFC)*RFC ) / ( (RF2-RFC)*D1 )  )        PARAMETER ( RICR    = ( (RF1-RFC)*RFC ) / ( (RF2-RFC)*D1 )  )
3717    
3718        DIMENSION STBFCN(irun,NLEV+1), INTCHG(irun,NLEV)        integer istnlv
3719        DIMENSION DTHV  (irun,NLEV+1), DPK   (irun,NLEV+1)        integer i
       DIMENSION DU    (irun,NLEV+1), DV    (irun,NLEV+1)  
       DIMENSION DZITRP(irun,NLEV+1)  
       DIMENSION AAA   (irun,NLEV), BBB   (irun,NLEV)  
       DIMENSION CCC   (irun,NLEV), DDD   (irun,NLEV)  
3720  C  C
3721  C *********************************************************************  C *********************************************************************
3722  C ****           QUADRATIC INTERPOLATION OF RI TO RICR VIA          ***  C ****           QUADRATIC INTERPOLATION OF RI TO RICR VIA          ***
# Line 3879  C    QQE           -         EQUILIBRIUM Line 3779  C    QQE           -         EQUILIBRIUM
3779  C    BITSTB        -         BIT '1' WHERE QE GREATER THAN ZERO  C    BITSTB        -         BIT '1' WHERE QE GREATER THAN ZERO
3780  C  C
3781  C**********************************************************************  C**********************************************************************
3782  C        implicit none
3783  C  
3784    C Argument List Declarations
3785          integer nlev,nlay,irun
3786          real RI(irun,NLEV),STRT(irun,NLEV),DW2(irun,NLEV)
3787          real XL(irun,NLEV),ZKM(irun,NLEV),ZKH(irun,NLEV)
3788          real QE(irun,NLEV),QQE(irun,NLEV)
3789          INTEGER INTSTB(irun,nlev)
3790          real EE(irun,nlay-1),RF(irun,nlay-1)
3791    
3792    C Local Variables
3793          real b1,b2,d3,rf1,rf2,d3b2,d2,e5,d4,d1,d1half,d2half
3794          real rfc,ricr,ch,cm
3795        PARAMETER ( B1      =   16.6    )          PARAMETER ( B1      =   16.6    )  
3796        PARAMETER ( B2      =   10.1    )        PARAMETER ( B2      =   10.1    )
3797        PARAMETER ( D3      = 0.29397643 )        PARAMETER ( D3      = 0.29397643 )
# Line 3899  C Line 3809  C
3809        PARAMETER ( CH      = 2.5828674 )        PARAMETER ( CH      = 2.5828674 )
3810        PARAMETER ( CM      = CH / D1   )        PARAMETER ( CM      = CH / D1   )
3811    
3812          integer istnlv
3813        DIMENSION RI(irun,NLEV), STRT(irun,NLEV), DW2(irun,NLEV)        integer i
3814        DIMENSION XL(irun,NLEV),  ZKM(irun,NLEV), ZKH(irun,NLEV)  
       DIMENSION QE(irun,NLEV),  QQE(irun,NLEV)  
       INTEGER INTSTB(irun,nlev)  
       DIMENSION     EE(irun,nlay-1),  RF(irun,nlay-1)  
 C  
3815        ISTNLV = irun * NLEV        ISTNLV = irun * NLEV
3816  C  C
3817  C *********************************************************************  C *********************************************************************
# Line 3976  C    ZKH           -         HEAT TRANSP Line 3882  C    ZKH           -         HEAT TRANSP
3882  C    P3            -         PRODUCTION RATE OF TURBULENT KINETIC ENERG  C    P3            -         PRODUCTION RATE OF TURBULENT KINETIC ENERG
3883  C  C
3884  C**********************************************************************  C**********************************************************************
3885  C        implicit none
3886  C  
3887    C Argument list Declarations
3888          integer nlev,nlay,irun
3889          real Q(irun,NLEV),XL(irun,NLEV),STRT(irun,NLEV)
3890          real DW2(irun,NLEV)
3891          INTEGER INTSTB(irun,nlay), INTQ(irun,nlay)
3892          real ZKM(irun,NLEV),ZKH(irun,NLEV),P3(irun,NLEV)
3893    
3894    C Local Variables
3895          real a1,a2,a4,c1,a5,a3,b1,b2,b3,ff2,ff3,ff4
3896        PARAMETER ( A1      =   0.92    )        PARAMETER ( A1      =   0.92    )
3897        PARAMETER ( A2      =   0.74    )        PARAMETER ( A2      =   0.74    )
3898        PARAMETER ( A4      = 6. * A1 * A1)        PARAMETER ( A4      = 6. * A1 * A1)
# Line 3992  C Line 3906  C
3906        PARAMETER ( FF3     = (3.*A2*B2) - (9.*A2*A2 )  )        PARAMETER ( FF3     = (3.*A2*B2) - (9.*A2*A2 )  )
3907        PARAMETER ( FF4     = (3.*A2*B2) + (12.*A1*A2 )  )        PARAMETER ( FF4     = (3.*A2*B2) + (12.*A1*A2 )  )
3908    
3909          real F2(irun,nlay-1),F3(irun,nlay-1)
3910        DIMENSION   Q(irun,NLEV),  XL(irun,NLEV), STRT(irun,NLEV)        real F4(irun,nlay-1),XQ(irun,nlay-1)
3911        DIMENSION DW2(irun,NLEV)  
3912        DIMENSION ZKM(irun,NLEV), ZKH(irun,NLEV),   P3(irun,NLEV)        integer istnlv
3913  C        integer i
       DIMENSION F2(irun,nlay-1),  F3(irun,nlay-1)  
       DIMENSION F4(irun,nlay-1),  XQ(irun,nlay-1)  
       INTEGER INTSTB(irun,nlay), INTQ(irun,nlay)  
3914  C  C
3915        ISTNLV = irun * NLEV        ISTNLV = irun * NLEV
3916  C  C
# Line 4070  C    DXX1G         -         SOURCE TERM Line 3981  C    DXX1G         -         SOURCE TERM
3981  C    DXX1G         -         SOURCE TERM FOR XX2 AT GROUND  C    DXX1G         -         SOURCE TERM FOR XX2 AT GROUND
3982  C  C
3983  C**********************************************************************  C**********************************************************************
3984          implicit none
3985    
3986    C Argument List Declarations
3987          integer nlev,itype,irun
3988          real XX1(irun,NLEV+1),XX2(irun,NLEV+1)
3989          real RHOKDZ(irun,NLEV),FLXFAC(irun,NLEV+1)
3990          real DXX1G(irun),DXX2G(irun)
3991          real epsl
3992  C  C
3993  C        real AA(irun,nlev), BB(irun,nlev), CC(irun,nlev+1)
3994          integer istnlv,istnm1,nlevp1,istnlx
3995          integer i
       DIMENSION    XX1(irun,NLEV+1),    XX2(irun,NLEV+1)  
       DIMENSION RHOKDZ(irun,NLEV)  , FLXFAC(irun,NLEV+1)  
       DIMENSION  DXX1G(irun)    ,     DXX2G(irun)  
 C  
       DIMENSION AA(irun,nlev), BB(irun,nlev), CC(irun,nlev+1)  
3996  C  C
3997        ISTNLV = irun * NLEV        ISTNLV = irun * NLEV
3998        ISTNM1 = ISTNLV - irun        ISTNM1 = ISTNLV - irun
# Line 4137  C Line 4051  C
4051        RETURN        RETURN
4052        END        END
4053        SUBROUTINE VTRI0 ( A,B,C,F,Y,K,irun)        SUBROUTINE VTRI0 ( A,B,C,F,Y,K,irun)
4054        DIMENSION A(irun,K),B(irun,K),C(irun,K),Y(irun,K+1)        implicit none
4055        DIMENSION F(irun,K)  
4056          integer k,irun
4057          real A(irun,K),B(irun,K),C(irun,K),Y(irun,K+1)
4058          real F(irun,K)
4059    
4060          integer i,L,Lm1
4061  C  C
4062        DO 9000 I = 1,irun        DO 9000 I = 1,irun
4063         A(I,1) = 1. / A(I,1)         A(I,1) = 1. / A(I,1)
# Line 4163  C Line 4082  C
4082        END        END
4083  C  C
4084        SUBROUTINE VTRI1 ( A,B,Y,K,irun)        SUBROUTINE VTRI1 ( A,B,Y,K,irun)
4085        DIMENSION A(irun,K),B(irun,K),Y(irun,K+1)        implicit none
4086    
4087          integer k,irun
4088          real A(irun,K),B(irun,K),Y(irun,K+1)
4089    
4090          integer i,L
4091  C  C
4092        DO 200 L = K,1,-1        DO 200 L = K,1,-1
4093         DO 9000 I = 1,irun         DO 9000 I = 1,irun
# Line 4175  C Line 4099  C
4099        END        END
4100  C  C
4101        SUBROUTINE VTRI2 ( A,B,C,F,Y,K,irun)        SUBROUTINE VTRI2 ( A,B,C,F,Y,K,irun)
4102        DIMENSION A(irun,K),B(irun,K),C(irun,K),F(irun,K)        implicit none
4103        DIMENSION Y(irun,K+1)  
4104          integer k,irun
4105          real A(irun,K),B(irun,K),C(irun,K),F(irun,K)
4106          real Y(irun,K+1)
4107    
4108          integer i,L
4109  C  C
4110        DO 100 L = 2,K        DO 100 L = 2,K
4111         DO 9000 I = 1,irun         DO 9000 I = 1,irun
# Line 4237  C    DPSIH         -         D PSIH Line 4166  C    DPSIH         -         D PSIH
4166  C    BITRIB        -         BIT ARRAY - '1' WHERE RIB1 = 0  C    BITRIB        -         BIT ARRAY - '1' WHERE RIB1 = 0
4167  C  C
4168  C**********************************************************************  C**********************************************************************
4169  C        implicit none
4170  C  
4171    C Argument List Declarations
4172          integer nn,irun,itype
4173          real VRIB1(IRUN),VRIB2(IRUN)
4174          real VWS1(IRUN),VWS2(IRUN),VZ1(IRUN),VUSTAR(IRUN)
4175          integer IWATER(IRUN)
4176          real VAPSIM(IRUN),VAPSIHG(IRUN)
4177          real VPSIH(IRUN),VPSIG(IRUN),VX(IRUN)
4178          real VX0(IRUN),VY(IRUN),VY0(IRUN)
4179          LOGICAL LWATER
4180          real VDZETA(IRUN),VDZ0(IRUN),VDPSIM(IRUN)
4181          real VDPSIH(IRUN)
4182          integer INTRIB(IRUN)
4183          real VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)
4184          real VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)
4185          real VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)
4186          real VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)
4187          real VXNUM(irun),VDZETA1(irun),VDZETA2(irun)
4188          real VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)
4189          real VDPSIMC(irun),VDPSIHC(irun)
4190    
4191    C Local Variables
4192          real xx0max,prfac,xpfac,difsqt,ustz0s,h0byz0,usth0s
4193        PARAMETER ( XX0MAX  =   1.49821 )        PARAMETER ( XX0MAX  =   1.49821 )
4194        PARAMETER ( PRFAC  = 0.595864   )        PARAMETER ( PRFAC  = 0.595864   )
4195        PARAMETER ( XPFAC  = .55        )          PARAMETER ( XPFAC  = .55        )  
# Line 4247  C Line 4198  C
4198        PARAMETER ( H0BYZ0 =    30.0    )        PARAMETER ( H0BYZ0 =    30.0    )
4199        PARAMETER ( USTH0S =  H0BYZ0*USTZ0S )        PARAMETER ( USTH0S =  H0BYZ0*USTZ0S )
4200    
4201        DIMENSION VRIB1(IRUN),VRIB2(IRUN)        integer VINT1(irun),VINT2(irun)
4202        DIMENSION VWS1(IRUN),VWS2(IRUN),VZ1(IRUN),VUSTAR(IRUN)        real getcon,vk,bmdl,b2uhs
4203        DIMENSION VAPSIM(IRUN),VAPSIHG(IRUN)        integer i
       DIMENSION VPSIH(IRUN),VPSIG(IRUN),VX(IRUN)  
       DIMENSION VX0(IRUN),VY(IRUN),VY0(IRUN)  
       DIMENSION VDZETA(IRUN),VDZ0(IRUN),VDPSIM(IRUN)  
       DIMENSION VDPSIH(IRUN)  
       DIMENSION IWATER(IRUN),INTRIB(IRUN)  
       LOGICAL LWATER  
       DIMENSION VX0PSIM(irun),VG(irun),VG0(irun),VR1MG0(irun)  
       DIMENSION VZ2(irun),VDZSEA(irun),VAZ0(irun),VXNUM1(irun)  
       DIMENSION VPSIGB2(irun),VDX(irun),VDXPSIM(irun),VDY(irun)  
       DIMENSION VXNUM2(irun),VDEN(irun),VAWS1(irun),VXNUM3(irun)  
       DIMENSION VXNUM(irun),VDZETA1(irun),VDZETA2(irun)  
       DIMENSION VZCOEF2(irun),VZCOEF1(irun),VTEMPLIN(irun)  
       DIMENSION VDPSIMC(irun),VDPSIHC(irun)  
 C  
   
   
       DIMENSION VINT1(irun),VINT2(irun)  
 C  
4204  C  C
4205        vk = getcon('VON KARMAN')        vk = getcon('VON KARMAN')
4206        BMDL    = VK * XPFAC * PRFAC / DIFSQT        BMDL    = VK * XPFAC * PRFAC / DIFSQT
# Line 4525  C        COMPUTE ROUGHNESS LENGTH FOR OC Line 4458  C        COMPUTE ROUGHNESS LENGTH FOR OC
4458  C          BASED ON FUNCTIONS OF LARGE AND POND  C          BASED ON FUNCTIONS OF LARGE AND POND
4459  C          AND OF KONDO --- DESIGNED FOR K = .4  C          AND OF KONDO --- DESIGNED FOR K = .4
4460  C *********************************************************************  C *********************************************************************
4461  C        implicit none
4462  C  
4463    C Argument List Delcarations
4464          integer irun
4465          real VZSEA(IRUN),VUSTAR(IRUN),VDZSEA(IRUN)
4466          integer IWATER(IRUN)
4467          LOGICAL LDZSEA
4468    
4469    C Local Variables
4470          real USTMX1,USTMX2,USTMX3
4471        PARAMETER ( USTMX1 =   1.14973  )        PARAMETER ( USTMX1 =   1.14973  )
4472        PARAMETER ( USTMX2 =   0.381844 )        PARAMETER ( USTMX2 =   0.381844 )
4473        PARAMETER ( USTMX3 =   0.0632456)        PARAMETER ( USTMX3 =   0.0632456)
4474    
4475        DIMENSION VZSEA(IRUN),VUSTAR(IRUN),VDZSEA(IRUN)        real AA(IRUN,5),TEMP(IRUN)
4476        DIMENSION IWATER(IRUN)        integer INT2(IRUN),INT3(IRUN),INT4(IRUN)
4477        DIMENSION AA(IRUN ,5),TEMP(IRUN)        integer i,k
4478        LOGICAL LDZSEA  
4479        DIMENSION INT2(IRUN ), INT3(IRUN ), INT4(IRUN)        real AA1(5),AA2(5),AA3(5),AA4(5)
 C  
       DIMENSION AA1(5),AA2(5),AA3(5),AA4(5)  
4480        DATA AA1/.2030325E-5,0.0,0.0,0.0,0.0/        DATA AA1/.2030325E-5,0.0,0.0,0.0,0.0/
4481        DATA AA2/-0.402451E-08,0.239597E-04,0.117484E-03,0.191918E-03,        DATA AA2/-0.402451E-08,0.239597E-04,0.117484E-03,0.191918E-03,
4482       1         0.395649E-04/       1         0.395649E-04/
# Line 4620  C Line 4559  C
4559  C  C
4560        RETURN        RETURN
4561        END        END
       subroutine pntquants_turb(nlaygcm)  
 C**********************************************************************  
 C  Subroutine to initialize the list of quantities for turbulence  
 C    package point by point diagnostic output  
 C**********************************************************************  
       implicit none  
       integer nlaygcm  
       character * 40 name  
       integer nlev  
   
       name = 'mid pressure'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'edge pressure'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'mid p ** kappa'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'edge p ** kappa'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'theta before'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'theta virtual before'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'q before'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'u wind before'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'v wind before'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'heat cap ground'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'latent heat at ground'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'net surface rad'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'background heat transfer'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'tke before'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'richardson number before'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'theta after'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'theta virtual after'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'q after'  
       nlev = nlaygcm+1  
       call pntquants(name,nlev)  
       name = 'u wind after'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'v wind after'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'tke after'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'richardson number after'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'trb u flux'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'trb v flux'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'trb t flux'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'trb q flux'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'eddy coef mom'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'eddy coef heat'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'length scale'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'layer heights'  
       nlev = nlaygcm  
       call pntquants(name,nlev)  
       name = 'q ground'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'rib initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'cu initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'ct initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'ustar initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'rho sfc initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'z0 initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'zeta initial'  
       nlev = 1  
       call pntquants(name,nlev)  
       name = 'beta coeff'  
       nlev = 1  
       call pntquants(name,nlev)  
       return  
       end  
4562    
4563        subroutine seaice ( nocean, timstp, hice,        subroutine seaice ( nocean, timstp, hice,
4564       .                     eturb,  dedtc,         .                     eturb,  dedtc,  
# Line 4766  C*************************************** Line 4576  C***************************************
4576        real seaic(nocean)        real seaic(nocean)
4577    
4578  C  rho*C = 1.93e6 J/(m**3 K) ; Peixoto & Oort  C  rho*C = 1.93e6 J/(m**3 K) ; Peixoto & Oort
4579        real, parameter ::  rhoC = 1.93e6          real rhoC
4580          parameter (rhoC = 1.93e6)
4581    
4582        real faceps,getcon,latent,codt,deltg,hice        real faceps,getcon,latent,codt,deltg,hice
4583        integer i        integer i
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22