SUBROUTINE TURBL !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE TURBL !> !> SUBROUTINE: TURBL - VERTICAL TURBULENT EXCHANGE !> PROGRAMMER: JANJIC !> ORG: W/NP2 !> DATE: 95-03-20 !> !> ABSTRACT: !> TURBL UPDATES THE TURBULENT KINETIC ENERGY WITH THE PRODUCTION/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 !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> NONE !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: CTLBLK !> DYNAM !> EXCHM !> F77KINDS !> GLB_TABLE !> INDX !> LOOPS !> MAPPINGS !> MASKS !> MOMENTO !> MPPCOM !> PARMETA !> PARM_TBL !> PHYS !> PVRBLS !> TEMPCOM !> TIMMING !> TOPO !> VRBLS !> Z0EFFT !> !> DRIVER : EBU !> NEWFLT !> !> CALLS : DIFCOF !> EXCH !> MIXLEN !> PRODQ2 !> SGETMO !> SFCDIF !> SURFCE !> VDIFH !> VDIFQ !> VDIFV !> ZERO2 !> ZERO3 !> ZERO3_T !>-------------------------------------------------------------------------------------------------- USE CTLBLK USE DYNAM USE EXCHM USE F77KINDS USE GLB_TABLE USE INDX USE LOOPS USE MAPPINGS USE MASKS USE MOMENTO USE MPPCOM USE PARMETA USE PARM_TBL, ONLY : ITB, JTB , ITBQ , JTBQ USE PHYS USE PVRBLS USE SOIL, ONLY : IVGTYP USE TEMPCOM USE TIMMING USE TOPO USE VRBLS USE Z0EFFT ! IMPLICIT NONE ! INCLUDE "EXCHM.h" ! #include "sp.h" ! INTEGER(KIND=I4KIND), PARAMETER :: KTMQ2 = 1 ! REAL (KIND=R4KIND), PARAMETER :: CAPA = 0.28589641 REAL (KIND=R4KIND), PARAMETER :: G = 9.8 REAL (KIND=R4KIND), PARAMETER :: RG = 1. / G REAL (KIND=R4KIND), PARAMETER :: ROG = 287.04 / G REAL (KIND=R4KIND), PARAMETER :: EPSZ = 1.E-4 REAL (KIND=R4KIND), PARAMETER :: EPSQ2 = 0.12 ! INTEGER(KIND=I4KIND), PARAMETER :: IMJM = IM * JM - JM / 2 INTEGER(KIND=I4KIND), PARAMETER :: NHRZ = (IDIM2 - IDIM1 + 1) * (JDIM2 - JDIM1 + 1) ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2) ::& & CKLQ , CT , UZ0H , VZ0H , AKMSV ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, LM) ::& & APE , UCOL , VCOL ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, LM1) ::& & AKH , AKM , AKMCOL , AKHCOL ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, LP1) ::& & ZINT , ZCOL ! REAL (KIND=R4KIND), DIMENSION(LM1, IDIM1:IDIM2, JDIM1:JDIM2) ::& & AKH_T , AKM_T ! REAL (KIND=R4KIND), DIMENSION(LM, IDIM1:IDIM2, JDIM1:JDIM2) ::& & APECOL_T, UCOL_T , VCOL_T , TCOL_T , QCOL_T , Q2COL_T ! REAL (KIND=R4KIND), DIMENSION(LP1, IDIM1:IDIM2, JDIM1:JDIM2) ::& & ZCOL_T , ZCOL_T2 ! REAL (KIND=R4KIND), DIMENSION(LM1) ::& & GM , GH , EL ! REAL (KIND=R4KIND), DIMENSION(4) ::& & ZEFF !------------------------------------------------ ! THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY !------------------------------------------------ REAL (KIND=R8KIND) ::& & TIMEF !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ INTEGER(KIND=I4KIND) ::& & I , J , K , LMHK , LMHP , LPBL , IIM , JJM , JJ , & & II , LMVK , LMHM , IVGTYPIJ ! REAL (KIND=R4KIND) ::& & PDSL , APESTS , WMSK , RWMSK , HPBL , ULM , VLM , WSTAR , BTIM , & & EVPR ! 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) !--------------------------------------------------------------------- ! 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 DO I=MYIS_P1,MYIE_P1 ZINT(I,J,LP1) = EPSZ IF (SIGMA) ZINT(I,J,LP1) = RG * FIS(I,J) END DO END DO ! do10: DO K=LM,1,-1 ! !$omp parallel do private (APESTS, PDSL) ! DO J=MYJS1_P1,MYJE1_P1 DO I=MYIS_P1,MYIE_P1 PDSL = PD(I,J) * RES(I,J) APESTS = PDSL * AETA(K) + PT ! ZINT(I,J,K) = ZINT(I,J,K+1) + T(I,J,K) / APESTS * PDSL * DETA(K) * ROG & & * (Q(I,J,K) * 0.608 + 1.) ! ZINT(I,J,K) = (ZINT(I,J,K) - DFRLG(K)) * HTM(I,J,K) + DFRLG(K) ! APE(I,J,K) = (1.E5/APESTS) ** CAPA END DO END DO ! END DO do10 !------------------- ! REMOVE NEGATIVE Q2 !------------------- ! !$omp parallel do ! do40: DO K=1,LM DO J=MYJS_P1,MYJE_P1 DO I=MYIS_P1,MYIE_P1 Q2(I,J,K) = AMAX1(Q2(I,J,K) * HBM2(I,J), EPSQ2) END DO END DO END DO do40 ! !$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 END DO END DO !---------------------------------- ! PREPARE THE EXCHANGE COEFFICIENTS !---------------------------------- ! !---------------------------------------- ! COMPUTE VELOCITY COMPONENTS AT H POINTS !---------------------------------------- ! !$omp parallel do private (RWMSK, WMSK) ! do60: DO K=1,LM ! DO J=MYJS2_P1,MYJE2_P1 DO I=MYIS_P1,MYIE_P1 WMSK = VTM(I+IHE(J),J,K) + VTM(I+IHW(J),J,K) + VTM(I,J+1,K) + VTM(I,J-1,K) IF (WMSK > 0.) THEN RWMSK = 0.25 UCOL(I,J,K) = (U(I+IHE(J),J ,K) * VTM(I+IHE(J),J ,K) & & + U(I+IHW(J),J ,K) * VTM(I+IHW(J),J ,K) & & + U(I ,J+1,K) * VTM(I ,J+1,K) & & + U(I ,J-1,K) * VTM(I ,J-1,K)) & & * RWMSK ! VCOL(I,J,K) = (V(I+IHE(J),J ,K) * VTM(I+IHE(J),J ,K) & & + V(I+IHW(J),J ,K) * VTM(I+IHW(J),J ,K) & & + V(I ,J+1,K) * VTM(I ,J+1,K) & & + V(I ,J-1,K) * VTM(I ,J-1,K)) & & * RWMSK ELSE UCOL(I,J,K) = 0. VCOL(I,J,K) = 0. END IF END DO END DO ! END DO do60 !----------------------- ! 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) ! doout100: DO J=MYJS2_P1,MYJE2_P1 doin100: DO I=MYIS_P1,MYIE1_P1 ! LMHK = LMH(I,J) LMHP = LMHK + 1 LMHM = LMHK - 1 IVGTYPIJ = IVGTYP(I,J) ! 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), & !---------- ! GSM V100M !---------- & TH100(I,J) , Q100(I,J), U100(I,J), V100(I,J), & & 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), IVGTYPIJ) !-------- ! MORELLI !-------- XMOMFLUX(I,J) = UMFLX YMOMFLUX(I,J) = VMFLX AKM10(I,J) = AKMS10 ! END DO doin100 END DO doout100 !-------------------------------------------- ! 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 DO J=1,JM 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) !---------- ! GSM 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) END IF END DO END IF !------------------------- ! SOUTHERN GLOBAL BOUNDARY !------------------------- IF (MY_JS_GLB == 1) THEN DO J=1,2 DO I=1,IM 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) !---------- ! GSM 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) END IF END DO END DO END IF !------------------------- ! NORTHERN GLOBAL BOUNDARY !------------------------- IF (MY_JE_GLB == JM) THEN DO J=JM-1,JM JJ = J - MY_JS_GLB + 1 DO I=1,IM 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) !---------- ! GSM 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) END IF END DO END DO END IF ! 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 ! doout125: DO J=MYJS2,MYJE2 doin125: DO 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 END DO doin125 END DO doout125 !----------------------------- ! 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 K=1,LM1 DO J=MYJS2,MYJE2 DO I=MYIS,MYIE AKMCOL(I,J,K) = (AKM(I+IVE(J),J ,K) * HBM2(I+IVE(J),J ) & & + AKM(I+IVW(J),J ,K) * HBM2(I+IVW(J),J ) & & + AKM(I ,J+1,K) * HBM2(I ,J+1) & + AKM(I ,J-1,K) * HBM2(I ,J-1)) & & * VTM(I ,J ,K) * VBM2(I ,J ) * 0.25 ! AKHCOL(I,J,K) = AKH(I ,J ,K) * HTM(I ,J,K) * HBM2(I,J) END DO END DO END DO ! !$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 END DO END DO ! !$omp parallel do ! DO K=1,LP1 DO J=MYJS2,MYJE2 DO I=MYIS,MYIE ZCOL(I,J,K) = 0.25 * (ZINT(I+IVE(J),J ,K) + ZINT(I+IVW(J),J ,K) & & + ZINT(I ,J+1,K) + ZINT(I ,J-1,K)) END DO END DO END DO !--------- ! MORELLI !--------- BTIM=TIMEF() ! CALL EXCH(AKM10, 1, 1, 1) ! EXCH_TIM = EXCH_TIM + TIMEF() - BTIM ! 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) END IF END DO END DO !----------------- ! 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) ! doout200: DO J=MYJS2,MYJE2 doin200: DO 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), & & APECOL_T(1,I,J), ZCOL_T(1,I,J), EVPR) ! PD(I,J) = PD(I,J) + PD(I,J) * RES(I,J) * EVPR !-------------------------------------------------------- ! 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)) ! END DO doin200 END DO doout200 !-------------------------------------------- ! 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 K=1,LM DO J=MYJS,MYJE DO I=MYIS,MYIE Q2(I,J,K) = AMAX1(Q2(I,J,K) * HBM2(I,J), EPSQ2) END DO END DO END DO ! RETURN ! END SUBROUTINE TURBL