SUBROUTINE TURBL ! ****************************************************************** !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: TURBL VERTICAL TURBULENT EXCHANGE ! PRGRMMR: JANJIC ORG: W/NP2 DATE: 95-03-20 ! ABSTRACT: ! TURBL UPDATES THE TURBULENT KINETIC ENERGY WITH THE PROD- ! UCTION/DISSIPATION TERM AND THE VERTICAL DIFFUSION TERM ! DIFFUSION TERM (USING AN IMPLICIT FORMULATION). EXCHANGE ! COEFFICIENTS FOR THE SURFACE AND FOR ALL LAYER INTERFACES ! ARE THEN COMPUTED AND THE EXCHANGE IS EXECUTED. ! PROGRAM HISTORY LOG: ! 95-03-15 JANJIC - ORIGINATOR ! 95-03-28 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL ! 96-03-29 BLACK - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON ! 96-07-19 MESINGER - ADDED Z0 EFFECTIVE ! 98-??-?? TUCCILLO - MODIFIED FOR CLASS VIII PARALLELISM ! 98-10-27 BLACK - PARALLEL CHANGES INTO MOST RECENT CODE ! USAGE: CALL TURBL FROM MAIN PROGRAM EBU ! INPUT ARGUMENT LIST: ! NONE ! OUTPUT ARGUMENT LIST: ! NONE ! OUTPUT FILES: ! NONE ! SUBPROGRAMS CALLED: ! UNIQUE: MIXLEN ! PRODQ2 ! DIFCOF ! SFCDIF ! VDIFH ! VDIFQ ! VDIFV ! LIBRARY: NONE ! COMMON BLOCKS: CTLBLK ! LOOPS ! MASKS ! DYNAM ! PHYS2 ! VRBLS ! PVRBLS ! INDX ! Z0EFFT ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ !*********************************************************************** !----------------------------------------------------------------------- INCLUDE "EXCHM.h" INCLUDE "parmeta.f90" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- PARAMETER & (KTMQ2=1,CAPA=0.28589641,G=9.8,RG=1./G,ROG=287.04/G & , EPSZ=1.E-4,EPSQ2=0.2 & , IMJM=IM*JM-JM/2,LM1=LM-1,LP1=LM+1,JAM=6+2*(JM-10) & , ITB=76,JTB=134,ITBQ=152,JTBQ=440 & , NHRZ=(IDIM2-IDIM1+1)*(JDIM2-JDIM1+1)) !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_LOOPS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_DYNAM.f90" !----------------------------------------------------------------------- INCLUDE "COMM_PHYS2.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_PVRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_INDX.f90" !----------------------------------------------------------------------- INCLUDE "COMM_Z0EFFT.f90" !----------------------------------------------------------------------- ! morelli common momento COMMON /MOMENTO/ UMFLX,VMFLX,AKMS10 ! morelli end LOGICAL :: & RUN,FIRST,RESTRT,SIGMA !----------------------------------------------------------------------- REAL :: & CKLQ(IDIM1:IDIM2,JDIM1:JDIM2) & ,CT (IDIM1:IDIM2,JDIM1:JDIM2) & ,APE (IDIM1:IDIM2,JDIM1:JDIM2,LM) & ,AKH (IDIM1:IDIM2,JDIM1:JDIM2,LM1) & ,AKM (IDIM1:IDIM2,JDIM1:JDIM2,LM1) & ,ZINT(IDIM1:IDIM2,JDIM1:JDIM2,LP1) & ,UZ0H(IDIM1:IDIM2,JDIM1:JDIM2) & ,VZ0H(IDIM1:IDIM2,JDIM1:JDIM2) REAL :: & AKMCOL(IDIM1:IDIM2,JDIM1:JDIM2,LM1) & ,AKHCOL(IDIM1:IDIM2,JDIM1:JDIM2,LM1) & ,AKMSV (IDIM1:IDIM2,JDIM1:JDIM2) & ,ZCOL (IDIM1:IDIM2,JDIM1:JDIM2,LP1) & ,UCOL (IDIM1:IDIM2,JDIM1:JDIM2,LM) & ,VCOL (IDIM1:IDIM2,JDIM1:JDIM2,LM) REAL :: & AKH_T (LM1,IDIM1:IDIM2,JDIM1:JDIM2) & ,AKM_T (LM1,IDIM1:IDIM2,JDIM1:JDIM2) & ,APECOL_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) & ,ZCOL_T (LP1,IDIM1:IDIM2,JDIM1:JDIM2) & ,ZCOL_T2 (LP1,IDIM1:IDIM2,JDIM1:JDIM2) & ,UCOL_T (LM,IDIM1:IDIM2,JDIM1:JDIM2) & ,VCOL_T (LM,IDIM1:IDIM2,JDIM1:JDIM2) & ,TCOL_T (LM,IDIM1:IDIM2,JDIM1:JDIM2) & ,QCOL_T (LM,IDIM1:IDIM2,JDIM1:JDIM2) & ,Q2COL_T (LM,IDIM1:IDIM2,JDIM1:JDIM2) REAL :: & GM(LM1),GH(LM1),EL(LM1),ZEFF(4) !----------------------------------------------------------------------- !*** !*** THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY !*** real*8 :: timef real :: nhb_tim,mpp_tim,init_tim common/timing/surfce_tim,nhb_tim,res_tim,exch_tim !*********************************************************************** !----------------------------------------------------------------------- CALL ZERO3(AKM,LM1) CALL ZERO3(ZINT,LP1) CALL ZERO3_T(AKH_T,LM1) CALL ZERO3_T(AKM_T,LM1) CALL ZERO2(UZ0H) CALL ZERO2(VZ0H) CALL ZERO2(AKM10) ! m AKMS was zeroed out by mistake, see the corresp. with SM, Feb.22, 07 !----------------------------------------------------------------------- !*** !*** COMPUTE THE HEIGHTS OF THE LAYER INTERFACES AND THE EXNER FUNCTION !*** ! omp parallel do DO J=MYJS_P1,MYJE_P1 ! This line is correct ! DO J=MYJS2_P1,MYJE2_P1 ! This line matches operations DO I=MYIS_P1,MYIE_P1 ZINT(I,J,LP1)=EPSZ IF(SIGMA)ZINT(I,J,LP1)=RG*FIS(I,J) ENDDO ENDDO DO 10 L=LM,1,-1 ! omp parallel do private (apests,pdsl) DO J=MYJS1_P1,MYJE1_P1 ! This line is correct ! DO J=MYJS2_P1,MYJE2_P1 ! This line matches operations DO I=MYIS_P1,MYIE_P1 PDSL=PD(I,J)*RES(I,J) APESTS=PDSL*AETA(L)+PT ZINT(I,J,L)=ZINT(I,J,L+1)+T(I,J,L)/APESTS & *PDSL*DETA(L)*ROG*(Q(I,J,L)*0.608+1.) ZINT(I,J,L)=(ZINT(I,J,L)-DFRLG(L))*HTM(I,J,L)+DFRLG(L) APE(I,J,L)=(1.E5/APESTS)**CAPA ENDDO ENDDO 10 END DO !----------------------------------------------------------------------- !*** !*** REMOVE NEGATIVE Q2 !*** ! omp parallel do DO 40 L=1,LM DO J=MYJS_P1,MYJE_P1 DO I=MYIS_P1,MYIE_P1 Q2(I,J,L)=AMAX1(Q2(I,J,L)*HBM2(I,J),EPSQ2) ENDDO ENDDO 40 END DO !----------------------------------------------------------------------- ! omp parallel do DO J=MYJS2_P1,MYJE2_P1 DO I=MYIS_P1,MYIE_P1 UZ0H(I,J)=(UZ0(I+IHE(J),J)+UZ0(I+IHW(J),J) & +UZ0(I,J+1)+UZ0(I,J-1))*HBM2(I,J)*0.25 VZ0H(I,J)=(VZ0(I+IHE(J),J)+VZ0(I+IHW(J),J) & +VZ0(I,J+1)+VZ0(I,J-1))*HBM2(I,J)*0.25 ENDDO ENDDO !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** PREPARE THE EXCHANGE COEFFICIENTS !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** !*** COMPUTE VELOCITY COMPONENTS AT H POINTS !*** ! omp parallel do private(rwmsk,wmsk) DO 60 L=1,LM DO J=MYJS2_P1,MYJE2_P1 DO I=MYIS_P1,MYIE_P1 WMSK=VTM(I+IHE(J),J,L)+VTM(I+IHW(J),J,L) & +VTM(I,J+1,L)+VTM(I,J-1,L) IF(WMSK > 0.)THEN ! STP2005 RWMSK=1./WMSK RWMSK=0.25 UCOL(I,J,L)=(U(I+IHE(J),J,L)*VTM(I+IHE(J),J,L) & +U(I+IHW(J),J,L)*VTM(I+IHW(J),J,L) & +U(I,J+1,L)*VTM(I,J+1,L)+U(I,J-1,L)*VTM(I,J-1,L)) & *RWMSK VCOL(I,J,L)=(V(I+IHE(J),J,L)*VTM(I+IHE(J),J,L) & +V(I+IHW(J),J,L)*VTM(I+IHW(J),J,L) & +V(I,J+1,L)*VTM(I,J+1,L)+V(I,J-1,L)*VTM(I,J-1,L)) & *RWMSK ELSE UCOL(I,J,L)=0. VCOL(I,J,L)=0. ENDIF ENDDO ENDDO 60 END DO !*** !*** FILL TRANSPOSED ARRAYS !*** ! omp parallel sections ! omp section CALL SGETMO(T,NHRZ,NHRZ,LM,TCOL_T,LM) ! omp section CALL SGETMO(Q,NHRZ,NHRZ,LM,QCOL_T,LM) ! omp section CALL SGETMO(APE,NHRZ,NHRZ,LM,APECOL_T,LM) ! omp section CALL SGETMO(Q2,NHRZ,NHRZ,LM,Q2COL_T,LM) ! omp section CALL SGETMO(ZINT,NHRZ,NHRZ,LP1,ZCOL_T,LP1) ! omp section CALL SGETMO(UCOL,NHRZ,NHRZ,LM,UCOL_T,LM) ! omp section CALL SGETMO(VCOL,NHRZ,NHRZ,LM,VCOL_T,LM) ! omp end parallel sections !---------------------------------------------------------------------- !*** !*** FIND THE MIXING LENGTH !*** ! omp parallel do private(el,gh,gm,hpbl,lmhk,lmhm,lmhp,lpbl) ! omp& private(ulm,vlm,wstar,zeff) DO 100 J=MYJS2_P1,MYJE2_P1 DO 100 I=MYIS_P1,MYIE1_P1 LMHK=LMH(I,J) LMHP=LMHK+1 LMHM=LMHK-1 CALL MIXLEN(LMHK,LPBL,HPBL,UCOL_T(1,I,J),VCOL_T(1,I,J) & , TCOL_T(1,I,J),QCOL_T(1,I,J),Q2COL_T(1,I,J) & , APECOL_T(1,I,J),ZCOL_T(1,I,J),GM,GH,EL) !----------------------------------------------------------------------- !*** !*** SOLVE FOR THE PRODUCTION/DISSIPATION OF !*** THE TURBULENT KINETIC ENERGY !*** CALL PRODQ2(LMHK,DTQ2,USTAR(I,J),GM,GH,EL,Q2COL_T(1,I,J)) !----------------------------------------------------------------------- !*** !*** FIND THE EXCHANGE COEFFICIENTS IN THE FREE ATMOSPHERE !*** CALL DIFCOF(LMHK,GM,GH,EL,Q2COL_T(1,I,J) & , ZCOL_T(1,I,J),AKM_T(1,I,J),AKH_T(1,I,J)) !----------------------------------------------------------------------- !*** !*** CARRY OUT THE VERTICAL DIFFUSION OF !*** TURBULENT KINETIC ENERGY !*** CALL VDIFQ(LMHK,KTMQ2,DTQ2,Q2COL_T(1,I,J),EL,ZCOL_T(1,I,J)) !----------------------------------------------------------------------- !*** !*** FIND THE Z0 EFFECTIVE !*** ZEFF(1)=ZEFFIJ(I,J,1) ZEFF(2)=ZEFFIJ(I,J,2) ZEFF(3)=ZEFFIJ(I,J,3) ZEFF(4)=ZEFFIJ(I,J,4) !----------------------------------------------------------------------- !*** !*** FIND THE SURFACE EXCHANGE COEFFICIENTS !*** ULM=UCOL(I,J,LMHK) VLM=VCOL(I,J,LMHK) CALL SFCDIF(LMHK,SM(I,J),THS(I,J),QS(I,J) & , UZ0H(I,J),VZ0H(I,J),THZ0(I,J),QZ0(I,J) & , USTAR(I,J),WSTAR & , Z0(I,J),ZEFF,AKMS(I,J),AKHS(I,J),HPBL,CT(I,J) & , U10(I,J),V10(I,J),TSHLTR(I,J),TH10(I,J) & , QSHLTR(I,J),Q10(I,J) & ! SM v100m , TH100(I,J),Q100(I,J),U100(I,J),V100(I,J) & ! SM v100m , ULM,VLM,TCOL_T(1,I,J),QCOL_T(1,I,J) & , APECOL_T(1,I,J),ZCOL_T(1,I,J),PD(I,J),PT & , T(I,J,LMHK)) ! morelli XMOMFLUX(I,J)=UMFLX YMOMFLUX(I,J)=VMFLX AKM10(i,j)=AKMS10 ! morelli end 100 END DO !------------------------------------------------------------------------ !*** !*** FILL STANDARD ARRAYS FROM TRANSPOSED ARRAYS !*** ! omp parallel sections ! omp section CALL SGETMO(Q2COL_T,LM,LM,NHRZ,Q2,NHRZ) ! omp section CALL SGETMO(AKH_T,LM1,LM1,NHRZ,AKH,NHRZ) ! omp section CALL SGETMO(AKM_T,LM1,LM1,NHRZ,AKM,NHRZ) ! omp end parallel sections !----------------------------------------------------------------------- !*** !*** UNCOMPUTED LOCATIONS MUST BE FILLED IN FOR THE POST-PROCESSOR !*** IIM=IM-MY_IS_GLB+1 JJM=JM-MY_JS_GLB+1 !*** EASTERN GLOBAL BOUNDARY IF(MY_IE_GLB == IM)THEN !GSM DO J=1,JM DO J=MYJS,MYJE IF(J >= MY_JS_GLB .AND. J <= MY_JE_GLB)THEN JJ=J-MY_JS_GLB+1 TH10(IIM,JJ)=TH10(IIM-1,JJ) Q10(IIM,JJ)=Q10(IIM-1,JJ) U10(IIM,JJ)=U10(IIM-1,JJ) V10(IIM,JJ)=V10(IIM-1,JJ) TSHLTR(IIM,JJ)=TSHLTR(IIM-1,JJ) QSHLTR(IIM,JJ)=QSHLTR(IIM-1,JJ) ! SM v100m TH100(IIM,JJ)=TH100(IIM-1,JJ) Q100(IIM,JJ)=Q100(IIM-1,JJ) U100(IIM,JJ)=U100(IIM-1,JJ) V100(IIM,JJ)=V100(IIM-1,JJ) ! SM v100m ENDIF ENDDO ENDIF !*** SOUTHERN GLOBAL BOUNDARY IF(MY_JS_GLB == 1)THEN DO J=1,2 !GSM DO I=1,IM DO I=MYIS,MYIE IF(I >= MY_IS_GLB .AND. I <= MY_IE_GLB)THEN II=I-MY_IS_GLB+1 TH10(II,J)=TH10(II,3) Q10(II,J)=Q10(II,3) U10(II,J)=U10(II,3) V10(II,J)=V10(II,3) TSHLTR(II,J)=TSHLTR(II,3) QSHLTR(II,J)=QSHLTR(II,3) ! SM v100m TH100(II,J)=TH100(II,3) Q100(II,J)=Q100(II,3) U100(II,J)=U100(II,3) V100(II,J)=V100(II,3) ! SM v100m ENDIF ENDDO ENDDO ENDIF !*** NORTHERN GLOBAL BOUNDARY IF(MY_JE_GLB == JM)THEN !GSM DO J=JM-1,JM DO J=MYJS,MYJE JJ=J-MY_JS_GLB+1 !GSM DO I=1,IM DO I=MYIS,MYIE IF(I >= MY_IS_GLB .AND. I <= MY_IE_GLB)THEN II=I-MY_IS_GLB+1 TH10(II,JJ)=TH10(II,JJM-2) Q10(II,JJ)=Q10(II,JJM-2) U10(II,JJ)=U10(II,JJM-2) V10(II,JJ)=V10(II,JJM-2) TSHLTR(II,JJ)=TSHLTR(II,JJM-2) QSHLTR(II,JJ)=QSHLTR(II,JJM-2) ! SM v100m TH100(II,JJ)=TH100(II,JJM-2) Q100(II,JJ)=Q100(II,JJM-2) U100(II,JJ)=U100(II,JJM-2) V100(II,JJ)=V100(II,JJM-2) ! SM v100m ENDIF ENDDO ENDDO ENDIF !----------------------------------------------------------------------- !----------------------------------------------------------------------- !----------------------------------------------------------------------- btim=timef() CALL EXCH(UZ0H,1,VZ0H,1,1,1) exch_tim=exch_tim+timef()-btim !*** !*** AVERAGE UZ0 AND VZ0 BACK TO V POINTS !*** ! omp parallel do DO 125 J=MYJS2,MYJE2 DO 125 I=MYIS,MYIE UZ0(I,J)=(UZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) & +UZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) & +UZ0H(I,J+1)*HBM2(I,J+1)+UZ0H(I,J-1)*HBM2(I,J-1))*0.25 VZ0(I,J)=(VZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) & +VZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) & +VZ0H(I,J+1)*HBM2(I,J+1)+VZ0H(I,J-1)*HBM2(I,J-1))*0.25 125 END DO !----------------------------------------------------------------------- !*** !*** EXECUTE THE GROUND PROCESSES !*** CALL SURFCE(APE(IDIM1,JDIM1,1),ZINT(IDIM1,JDIM1,1) & , CKLQ(IDIM1,JDIM1)) !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** EXECUTE THE VERTICAL EXCHANGE !----------------------------------------------------------------------- !----------------------------------------------------------------------- btim=timef() CALL EXCH(AKMS,1,AKM,LM1,ZINT,LP1,1,1) exch_tim=exch_tim+timef()-btim ! omp parallel do DO L=1,LM1 DO J=MYJS2,MYJE2 DO I=MYIS,MYIE AKMCOL(I,J,L)=(AKM(I+IVE(J),J,L)*HBM2(I+IVE(J),J) & +AKM(I+IVW(J),J,L)*HBM2(I+IVW(J),J) & +AKM(I,J+1,L)*HBM2(I,J+1)+AKM(I,J-1,L)*HBM2(I,J-1)) & *VTM(I,J,L)*VBM2(I,J)*0.25 AKHCOL(I,J,L)=AKH(I,J,L)*HTM(I,J,L)*HBM2(I,J) ENDDO ENDDO ENDDO ! omp parallel do DO J=MYJS2,MYJE2 DO I=MYIS,MYIE THZ0(I,J)=(1.-SM(I,J))*THS(I,J)+SM(I,J)*THZ0(I,J) QZ0 (I,J)=(1.-SM(I,J))*QS (I,J)+SM(I,J)*QZ0 (I,J) AKMSV(I,J)=(AKMS(I+IVE(J),J)*HBM2(I+IVE(J),J) & +AKMS(I+IVW(J),J)*HBM2(I+IVW(J),J) & +AKMS(I,J+1)*HBM2(I,J+1)+AKMS(I,J-1)*HBM2(I,J-1)) & *VBM2(I,J)*0.25 ENDDO ENDDO ! omp parallel do DO L=1,LP1 DO J=MYJS2,MYJE2 DO I=MYIS,MYIE ZCOL(I,J,L)=0.25*(ZINT(I+IVE(J),J,L)+ZINT(I+IVW(J),J,L) & +ZINT(I,J+1,L)+ZINT(I,J-1,L)) ENDDO ENDDO ENDDO ! morelli DO J=MYJS2,MYJE2 DO I=MYIS,MYIE LMVK=LMV(I,J) AKM10V(I,J)=(AKM10(I+IVE(J),J)*HBM2(I+IVE(J),J) & +AKM10(I+IVW(J),J)*HBM2(I+IVW(J),J) & +AKM10(I,J+1)*HBM2(I,J+1)+AKM10(I,J-1)*HBM2(I,J-1)) & *VBM2(I,J)*0.25 IF(AKM10V(I,J) == 0) THEN U10(I,J)=0. V10(I,J)=0. ELSE U10(I,J)=AKMSV(I,J)*(U(I,J,LMVK)-UZ0(I,J))/AKM10V(I,J)+UZ0(I,J) V10(I,J)=AKMSV(I,J)*(V(I,J,LMVK)-VZ0(I,J))/AKM10V(I,J)+VZ0(I,J) ENDIF ENDDO ENDDO ! morelli end !*** !*** TRANSPOSE ARRAYS !*** ! omp parallel sections ! omp section CALL SGETMO(ZCOL,NHRZ,NHRZ,LP1,ZCOL_T2,LP1) ! omp section CALL SGETMO(U,NHRZ,NHRZ,LM,UCOL_T,LM) ! omp section CALL SGETMO(V,NHRZ,NHRZ,LM,VCOL_T,LM) ! omp section CALL SGETMO(AKHCOL,NHRZ,NHRZ,LM1,AKH_T,LM1) ! omp section CALL SGETMO(AKMCOL,NHRZ,NHRZ,LM1,AKM_T,LM1) ! omp end parallel sections !----------------------------------------------------------------------- ! omp parallel do private(lmhk,lmvk) DO 200 J=MYJS2,MYJE2 DO 200 I=MYIS,MYIE1 LMHK=LMH(I,J) LMVK=LMV(I,J) !*** !*** CARRY OUT THE VERTICAL DIFFUSION OF !*** TEMPERATURE AND WATER VAPOR !*** CALL VDIFH(LMHK,KTMQ2,DTQ2,THZ0(I,J),QZ0(I,J),AKHS(I,J) & , CT(I,J),CKLQ(I,J) & , TCOL_T(1,I,J),QCOL_T(1,I,J),AKH_T(1,I,J) & ! ule 3, APECOL_T(1,I,J),ZCOL_T(1,I,J)) , APECOL_T(1,I,J),ZCOL_T(1,I,J),EVPR) ! ule PD(I,J)=PD(I,J)+PD(I,J)*RES(I,J)*EVPR ! ule !----------------------------------------------------------------------- !*** !*** CARRY OUT THE VERTICAL DIFFUSION OF !*** VELOCITY COMPONENTS !*** CALL VDIFV(LMVK,KTMQ2,DTQ2,UZ0(I,J),VZ0(I,J) & , AKMSV(I,J),UCOL_T(1,I,J),VCOL_T(1,I,J) & , AKM_T(1,I,J),ZCOL_T2(1,I,J)) !----------------------------------------------------------------------- 200 END DO !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** !*** FILL STANDARD ARRAYS FROM TRANSPOSED ARRAYS !*** ! omp parallel sections ! omp section CALL SGETMO(QCOL_t,LM,LM,NHRZ,Q,NHRZ) ! omp section CALL SGETMO(TCOL_t,LM,LM,NHRZ,T,NHRZ) ! omp section CALL SGETMO(UCOL_t,LM,LM,NHRZ,U,NHRZ) ! omp section CALL SGETMO(VCOL_t,LM,LM,NHRZ,V,NHRZ) ! omp end parallel sections !*** !*** REMOVE NEGATIVE Q2 !*** ! omp parallel do DO L=1,LM DO J=MYJS,MYJE DO I=MYIS,MYIE Q2(I,J,L)=AMAX1(Q2(I,J,L)*HBM2(I,J),EPSQ2) ENDDO ENDDO ENDDO !---------------------------------------------------------------------- RETURN END SUBROUTINE TURBL