C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
SUBROUTINE BOCOH
C ******************************************************************
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . .
C SUBPROGRAM: BOCOH UPDATE MASS POINTS ON BOUNDARY
C PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
C
C ABSTRACT:
C TEMPERATURE, SPECIFIC HUMIDITY, AND SURFACE PRESSURE
C ARE UPDATED ON THE DOMAIN BOUNDARY BY APPLYING THE
C PRE-COMPUTED TENDENCIES AT EACH TIME STEP.
C
C PROGRAM HISTORY LOG:
C 87-??-?? MESINGER - ORIGINATOR
C 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D in HORIZONTAL
C 96-12-13 BLACK - FINAL MODIFICATION FOR NESTED RUNS
C 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
C
C USAGE: CALL BOCOH FROM MAIN PROGRAM EBU
C INPUT ARGUMENT LIST:
C NONE
C
C OUTPUT ARGUMENT LIST:
C NONE
C
C OUTPUT FILES:
C NONE
C
C SUBPROGRAMS CALLED:
C
C UNIQUE: NONE
C
C LIBRARY: NONE
C
C COMMON BLOCKS: CTLBLK
C MASKS
C VRBLS
C PVRBLS
C CLDWTR
C BOCO
C MAPOT
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE : IBM SP
C$$$
C ******************************************************************
C-----------------------------------------------------------------------
INCLUDE "parmeta"
INCLUDE "mpif.h"
INCLUDE "mpp.h"
#include "sp.h"
C-----------------------------------------------------------------------
P A R A M E T E R
& (IMJM=IM*JM-JM/2,LB=2*IM+JM-3,LP1=LM+1)
P A R A M E T E R
& (ISIZ1=2*LB,ISIZ2=2*LB*LM)
C-----------------------------------------------------------------------
L O G I C A L
& RUN,FIRST,RESTRT,SIGMA
C-----------------------------------------------------------------------
INCLUDE "CTLBLK.comm"
C-----------------------------------------------------------------------
INCLUDE "MASKS.comm"
C-----------------------------------------------------------------------
INCLUDE "VRBLS.comm"
C-----------------------------------------------------------------------
INCLUDE "PVRBLS.comm"
C-----------------------------------------------------------------------
INCLUDE "CLDWTR.comm"
C-----------------------------------------------------------------------
INCLUDE "BOCO.comm"
C-----------------------------------------------------------------------
INCLUDE "MAPOT.comm"
C-----------------------------------------------------------------------
C***********************************************************************
c if(mype.eq.13) then
c print*,'At the start of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
C--------------READ FRESH BOUNDARY DATA IF NECESSARY--------------------
IF(NTSD-1.EQ.NBOCO)THEN
c print*,'am i in if block?'
IF(MYPE.EQ.0)THEN
c print*,'nbc=',nbc
print*,'BOCOH: read fresh boundary data NTSD=',NTSD
READ(NBC)PDB
READ(NBC)TB
READ(NBC)QB
READ(NBC)UB
READ(NBC)VB
READ(NBC)Q2B
READ(NBC)CWMB
ENDIF
C
CALL MPI_BCAST(PDB,ISIZ1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(TB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(QB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(UB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(VB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(Q2B,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
CALL MPI_BCAST(CWMB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
C***
C*** FIND NEXT BOUNDARY CONDITION READ
C***
IF(NTSD.LT.NTSTM)THEN
IF(MYPE.EQ.0)READ(NBC)BCHR
CALL MPI_BCAST(BCHR,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
NBOCO=INT(BCHR*TSPH+0.5)
IF(MYPE.EQ.0)THEN
print*,'NEXT read BCHR, NBOCO = ', BCHR, NBOCO
END IF
ENDIF
C
ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
IIM=IM-MY_IS_GLB+1
JJM=JM-MY_JS_GLB+1
C--------------------------------------------------------------
C***
C*** UPDATE THE SURFACE PRESSURE
C***
C--------------------------------------------------------------
c if(mype.eq.13) then
c print*,'1st break of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
N=1
DO 101 I=1,IM
PDB(N,1)=PDB(N,1)+PDB(N,2)*DT
IF(MY_JS_GLB.EQ.1.AND.I.GE.MY_IS_GLB-ILPAD1.
1 AND.I.LE.MY_IE_GLB+IRPAD1)THEN
II=I-MY_IS_GLB+1
PD(II,1)=PDB(N,1)
ENDIF
N=N+1
101 CONTINUE
C
DO 102 I=1,IM
PDB(N,1)=PDB(N,1)+PDB(N,2)*DT
IF(MY_JE_GLB.EQ.JM.AND.I.GE.MY_IS_GLB-ILPAD1.
1 AND.I.LE.MY_IE_GLB+IRPAD1)THEN
II=I-MY_IS_GLB+1
PD(II,JJM)=PDB(N,1)
ENDIF
N=N+1
102 CONTINUE
C
DO 103 J=3,JM-2,2
PDB(N,1)=PDB(N,1)+PDB(N,2)*DT
IF(MY_IS_GLB.EQ.1.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
PD(1,JJ)=PDB(N,1)
ENDIF
N=N+1
103 CONTINUE
C
DO 104 J=3,JM-2,2
PDB(N,1)=PDB(N,1)+PDB(N,2)*DT
IF(MY_IE_GLB.EQ.IM.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
PD(IIM,JJ)=PDB(N,1)
ENDIF
N=N+1
104 CONTINUE
c if(mype.eq.13) then
c print*,'2nd break of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
C--------------------------------------------------------------
C***
C*** UPDATE THE 3-D MASS VARIABLES
C***
C--------------------------------------------------------------
DO 115 L=1,LM
C--------------------------------------------------------------
N=1
DO 111 I=1,IM
TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
QB(N,L,1)=QB(N,L,1)+QB(N,L,2)*DT
Q2B(N,L,1)=Q2B(N,L,1)+Q2B(N,L,2)*DT
CWMB(N,L,1)=CWMB(N,L,1)+CWMB(N,L,2)*DT
IF(MY_JS_GLB.EQ.1.AND.I.GE.MY_IS_GLB-ILPAD1.
1 AND.I.LE.MY_IE_GLB+IRPAD1)THEN
II=I-MY_IS_GLB+1
T(II,1,L)=TB(N,L,1)
Q(II,1,L)=QB(N,L,1)
Q2(II,1,L)=Q2B(N,L,1)
CWM(II,1,L)=CWMB(N,L,1)
ENDIF
N=N+1
111 CONTINUE
C
c if(mype.eq.13) then
c print*,'Before 112 block'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
DO 112 I=1,IM
c if(mype.eq.13) then
c print*,'i,n,l,tb(n,l,1),tb(n,l,2),dt=',
c * i,n,l,tb(n,l,1),tb(n,l,2),dt
c endif
TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
QB(N,L,1)=QB(N,L,1)+QB(N,L,2)*DT
Q2B(N,L,1)=Q2B(N,L,1)+Q2B(N,L,2)*DT
CWMB(N,L,1)=CWMB(N,L,1)+CWMB(N,L,2)*DT
IF(MY_JE_GLB.EQ.JM.AND.I.GE.MY_IS_GLB-ILPAD1.
1 AND.I.LE.MY_IE_GLB+IRPAD1)THEN
II=I-MY_IS_GLB+1
c if(mype.eq.13.and.ii.eq.40.and.jjm.eq.77) then
c print*,'n,l=',n,l
c print*,'tb(n,l,1)=',tb(n,l,1)
c endif
T(II,JJM,L)=TB(N,L,1)
Q(II,JJM,L)=QB(N,L,1)
Q2(II,JJM,L)=Q2B(N,L,1)
CWM(II,JJM,L)=CWMB(N,L,1)
ENDIF
N=N+1
112 CONTINUE
C
c if(mype.eq.13) then
c print*,'Before 113 block'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
DO 113 J=3,JM-2,2
TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
QB(N,L,1)=QB(N,L,1)+QB(N,L,2)*DT
Q2B(N,L,1)=Q2B(N,L,1)+Q2B(N,L,2)*DT
CWMB(N,L,1)=CWMB(N,L,1)+CWMB(N,L,2)*DT
IF(MY_IS_GLB.EQ.1.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
T(1,JJ,L)=TB(N,L,1)
Q(1,JJ,L)=QB(N,L,1)
Q2(1,JJ,L)=Q2B(N,L,1)
CWM(1,JJ,L)=CWMB(N,L,1)
ENDIF
N=N+1
113 CONTINUE
C
c if(mype.eq.13) then
c print*,'Before 114 block'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
DO 114 J=3,JM-2,2
TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
QB(N,L,1)=QB(N,L,1)+QB(N,L,2)*DT
Q2B(N,L,1)=Q2B(N,L,1)+Q2B(N,L,2)*DT
CWMB(N,L,1)=CWMB(N,L,1)+CWMB(N,L,2)*DT
IF(MY_IE_GLB.EQ.IM.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
T(IIM,JJ,L)=TB(N,L,1)
Q(IIM,JJ,L)=QB(N,L,1)
Q2(IIM,JJ,L)=Q2B(N,L,1)
CWM(IIM,JJ,L)=CWMB(N,L,1)
ENDIF
N=N+1
114 CONTINUE
C
115 CONTINUE
c if(mype.eq.13) then
c print*,'3rd break of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
C--------------------------------------------------------------------
C
C------- SPACE INTERPOLATION OF PD AND T AT THE INNER BOUNDARY ------
C
C--------------------------------------------------------------------
IF(IBROW.EQ.1)THEN
DO 121 I=MYIS,MYIE1
SHTM=HTM(I,1,LM)+HTM(I+1,1,LM)+HTM(I,3,LM)+HTM(I+1,3,LM)
PD(I,2)=(PD(I,1)*HTM(I,1,LM)+PD(I+1,1)*HTM(I+1,1,LM)
1 +PD(I,3)*HTM(I,3,LM)+PD(I+1,3)*HTM(I+1,3,LM))/SHTM
121 CONTINUE
ENDIF
C
IF(ITROW.EQ.1)THEN
DO 122 I=MYIS,MYIE1
SHTM=HTM(I,JJM-2,LM)+HTM(I+1,JJM-2,LM)+HTM(I,JJM,LM)
1 +HTM(I+1,JJM,LM)
PD(I,JJM-1)=(PD(I,JJM-2)*HTM(I,JJM-2,LM)
1 +PD(I+1,JJM-2)*HTM(I+1,JJM-2,LM)
2 +PD(I,JJM)*HTM(I,JJM,LM)
3 +PD(I+1,JJM)*HTM(I+1,JJM,LM))/SHTM
122 CONTINUE
ENDIF
C
IF(ILCOL.EQ.1)THEN
DO 123 J=4,JM-3,2
IF(MY_IS_GLB.EQ.1.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
SHTM=HTM(1,JJ-1,LM)+HTM(2,JJ-1,LM)+HTM(1,JJ+1,LM)
1 +HTM(2,JJ+1,LM)
PD(1,JJ)=(PD(1,JJ-1)*HTM(1,JJ-1,LM)
1 +PD(2,JJ-1)*HTM(2,JJ-1,LM)
2 +PD(1,JJ+1)*HTM(1,JJ+1,LM)
3 +PD(2,JJ+1)*HTM(2,JJ+1,LM))/SHTM
ENDIF
123 CONTINUE
ENDIF
C
IF(IRCOL.EQ.1)THEN
DO 124 J=4,JM-3,2
IF(MY_IE_GLB.EQ.IM.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
SHTM=HTM(IIM-1,JJ-1,LM)+HTM(IIM,JJ-1,LM)
1 +HTM(IIM-1,JJ+1,LM)+HTM(IIM,JJ+1,LM)
PD(IIM-1,JJ)=(PD(IIM-1,JJ-1)*HTM(IIM-1,JJ-1,LM)
1 +PD(IIM,JJ-1)*HTM(IIM,JJ-1,LM)
2 +PD(IIM-1,JJ+1)*HTM(IIM-1,JJ+1,LM)
3 +PD(IIM,JJ+1)*HTM(IIM,JJ+1,LM))/SHTM
ENDIF
124 CONTINUE
ENDIF
c if(mype.eq.13) then
c print*,'4th break of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
C
C
C--------------------------------------------------------------------
DO 135 L=1,LM
C--------------------------------------------------------------------
c if(mype.eq.13) then
c print*,'l,ibrow,itrow,ircol,ilcol=',l,ibrow,itrow,ircol,ilcol
c endif
IF(IBROW.EQ.1)THEN
DO 131 I=MYIS,MYIE1
RHTM=1./(HTM(I,1,L)+HTM(I+1,1,L)+HTM(I,3,L)+HTM(I+1,3,L))
T(I,2,L)=(T(I,1,L)*HTM(I,1,L)+T(I+1,1,L)*HTM(I+1,1,L)
1 +T(I,3,L)*HTM(I,3,L)+T(I+1,3,L)*HTM(I+1,3,L))*RHTM
Q(I,2,L)=(Q(I,1,L)*HTM(I,1,L)+Q(I+1,1,L)*HTM(I+1,1,L)
1 +Q(I,3,L)*HTM(I,3,L)+Q(I+1,3,L)*HTM(I+1,3,L))*RHTM
Q2(I,2,L)=(Q2(I,1,L)*HTM(I,1,L)+Q2(I+1,1,L)*HTM(I+1,1,L)
1 +Q2(I,3,L)*HTM(I,3,L)+Q2(I+1,3,L)*HTM(I+1,3,L))*RHTM
CWM(I,2,L)=(CWM(I,1,L)*HTM(I,1,L)+CWM(I+1,1,L)*HTM(I+1,1,L)
1 +CWM(I,3,L)*HTM(I,3,L)+CWM(I+1,3,L)*HTM(I+1,3,L))
2 *RHTM
131 CONTINUE
ENDIF
C
IF(ITROW.EQ.1)THEN
c print*,'inside itrow.eq.1 block'
c print*,'myis,myie1=',myis,myie1
c print*,'jjm=',jjm
DO 132 I=MYIS,MYIE1
RHTM=1./(HTM(I,JJM-2,L)+HTM(I+1,JJM-2,L)
1 +HTM(I,JJM,L)+HTM(I+1,JJM,L))
c if(i.eq.40.and.jjm-1.eq.76.and.mype.eq.13) then
c if(i.eq.40.and.mype.eq.13) then
c print*,'i,jjm,l=',i,jjm,l
c print*,'T(I,JJM-2,L)=',T(I,JJM-2,L)
c print*,'HTM(I,JJM-2,L)=',HTM(I,JJM-2,L)
c print*,'T(I+1,JJM-2,L)=',T(I+1,JJM-2,L)
c print*,'HTM(I+1,JJM-2,L)=',HTM(I+1,JJM-2,L)
c print*,'T(I,JJM,L)=',T(I,JJM,L)
c print*,'HTM(I,JJM,L)=',HTM(I,JJM,L)
c print*,'T(I+1,JJM,L)=',T(I+1,JJM,L)
c print*,'HTM(I+1,JJM,L)=',HTM(I+1,JJM,L)
c print*,'rhtm=',rhtm
c endif
T(I,JJM-1,L)=(T(I,JJM-2,L)*HTM(I,JJM-2,L)
1 +T(I+1,JJM-2,L)*HTM(I+1,JJM-2,L)
2 +T(I,JJM,L)*HTM(I,JJM,L)
3 +T(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
Q(I,JJM-1,L)=(Q(I,JJM-2,L)*HTM(I,JJM-2,L)
1 +Q(I+1,JJM-2,L)*HTM(I+1,JJM-2,L)
2 +Q(I,JJM,L)*HTM(I,JJM,L)
3 +Q(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
Q2(I,JJM-1,L)=(Q2(I,JJM-2,L)*HTM(I,JJM-2,L)
1 +Q2(I+1,JJM-2,L)*HTM(I+1,JJM-2,L)
2 +Q2(I,JJM,L)*HTM(I,JJM,L)
3 +Q2(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
CWM(I,JJM-1,L)=(CWM(I,JJM-2,L)*HTM(I,JJM-2,L)
1 +CWM(I+1,JJM-2,L)*HTM(I+1,JJM-2,L)
2 +CWM(I,JJM,L)*HTM(I,JJM,L)
3 +CWM(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
132 CONTINUE
ENDIF
C
IF(ILCOL.EQ.1)THEN
DO 133 J=4,JM-3,2
IF(MY_IS_GLB.EQ.1.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
RHTM=1./(HTM(1,JJ-1,L)+HTM(2,JJ-1,L)
1 +HTM(1,JJ+1,L)+HTM(2,JJ+1,L))
T(1,JJ,L)=(T(1,JJ-1,L)*HTM(1,JJ-1,L)
1 +T(2,JJ-1,L)*HTM(2,JJ-1,L)
2 +T(1,JJ+1,L)*HTM(1,JJ+1,L)
3 +T(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
Q(1,JJ,L)=(Q(1,JJ-1,L)*HTM(1,JJ-1,L)
1 +Q(2,JJ-1,L)*HTM(2,JJ-1,L)
2 +Q(1,JJ+1,L)*HTM(1,JJ+1,L)
3 +Q(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
Q2(1,JJ,L)=(Q2(1,JJ-1,L)*HTM(1,JJ-1,L)
1 +Q2(2,JJ-1,L)*HTM(2,JJ-1,L)
2 +Q2(1,JJ+1,L)*HTM(1,JJ+1,L)
3 +Q2(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
CWM(1,JJ,L)=(CWM(1,JJ-1,L)*HTM(1,JJ-1,L)
1 +CWM(2,JJ-1,L)*HTM(2,JJ-1,L)
2 +CWM(1,JJ+1,L)*HTM(1,JJ+1,L)
3 +CWM(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
ENDIF
133 CONTINUE
ENDIF
C
IF(IRCOL.EQ.1)THEN
DO 134 J=4,JM-3,2
IF(MY_IE_GLB.EQ.IM.AND.J.GE.MY_JS_GLB-JBPAD1.
1 AND.J.LE.MY_JE_GLB+JTPAD1)THEN
JJ=J-MY_JS_GLB+1
RHTM=1./(HTM(IIM-1,JJ-1,L)+HTM(IIM,JJ-1,L)
1 +HTM(IIM-1,JJ+1,L)+HTM(IIM,JJ+1,L))
c if(iim-1.eq.40.and.jj.eq.77.and.mype.eq.13) then
c print*,'l=',l
c print*,'T(IIM-1,JJ-1,L)=',T(IIM-1,JJ-1,L)
c print*,'HTM(IIM-1,JJ-1,L)=',HTM(IIM-1,JJ-1,L)
c print*,'T(IIM,JJ-1,L)=',T(IIM,JJ-1,L)
c print*,'HTM(IIM,JJ-1,L)=',HTM(IIM,JJ-1,L)
c print*,'T(IIM-1,JJ+1,L)=',T(IIM-1,JJ+1,L)
c print*,'HTM(IIM-1,JJ+1,L)=',HTM(IIM-1,JJ+1,L)
c print*,'T(IIM,JJ+1,L)=',T(IIM,JJ+1,L)
c print*,'HTM(IIM,JJ+1,L)=',HTM(IIM,JJ+1,L)
c print*,'rhtm=',rhtm
c endif
T(IIM-1,JJ,L)=(T(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L)
1 +T(IIM,JJ-1,L)*HTM(IIM,JJ-1,L)
2 +T(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L)
2 +T(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
Q(IIM-1,JJ,L)=(Q(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L)
1 +Q(IIM,JJ-1,L)*HTM(IIM,JJ-1,L)
2 +Q(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L)
2 +Q(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
Q2(IIM-1,JJ,L)=(Q2(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L)
1 +Q2(IIM,JJ-1,L)*HTM(IIM,JJ-1,L)
2 +Q2(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L)
2 +Q2(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
CWM(IIM-1,JJ,L)=(CWM(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L)
1 +CWM(IIM,JJ-1,L)*HTM(IIM,JJ-1,L)
2 +CWM(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L)
2 +CWM(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
ENDIF
134 CONTINUE
ENDIF
135 CONTINUE
c if(mype.eq.13) then
c print*,'At the end of BOCOH'
c do l=1,60
c print*,'l,t(40,77,l)=',l,t(40,77,l)
c enddo
c endif
C--------------------------------------------------------------------
C--------------------------------------------------------------------
RETURN
END