SUBROUTINE CLO89(CLDFAC, CAMT, NCLDS, KBTM, KTOP) !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE CLO89 !> !> SUBPROGRAM: CLO89 - ????? !> PROGRAMMER: Q. ZHAO !> ORG: W/NP2 !> DATE: 95-03-22 !> !> ABSTRACT: !> COMPUTES CLOUD TRANSMISSION FUNCTIONS FOR THE LONGWAVE CODE,USING CODE WRITTEN BY BERT !> KATZ (301-763-8161) AND MODIFIED BY DAN SCHWARZKOPF IN DECEMBER, 1988. !> !> PROGRAM HISTORY LOG: !> 95-03-22 Q. ZHAO - ORIGINATOR !> 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: !> CAMT - !> KTOP - !> KBTM - !> NCLDS - !> !> OUTPUT ARGUMENT LIST: !> CLDFAC - !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: F77KINDS !> GLB_TABLE !> HCON !> MAPPINGS !> MPPCOM !> PARMETA !> PHYCON !> TEMPCOM !> TOPO !> !> DRIVER : RADFS !> !> CALLS : ----- !>-------------------------------------------------------------------------------------------------- USE F77KINDS USE GLB_TABLE USE HCON USE MAPPINGS USE MPPCOM USE PARMETA USE PHYCON USE TEMPCOM USE TOPO ! IMPLICIT NONE ! #include "sp.h" !---------------------------------------------------------------------------------------- ! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: ! IMAX = NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS ! L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL ! NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS ! ! NBLW = NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE BANDTA FOR DEFINITION ! NBLX = NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS ! NBLY = NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE BDCOMB FOR DEFINITION ! INLTE = NO. LEVELS USED FOR NLTE CALCS. ! NNLTE = INDEX NO. OF FREQ. BAND IN NLTE CALCS. ! ! NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED FROM THE ABOVE PARAMETERS !---------------------------------------------------------------------------------------- INTEGER(KIND=I4KIND), PARAMETER :: L = LM INTEGER(KIND=I4KIND), PARAMETER :: IMAX = IM INTEGER(KIND=I4KIND), PARAMETER :: NCOL = IMAX INTEGER(KIND=I4KIND), PARAMETER :: NBLW = 163 INTEGER(KIND=I4KIND), PARAMETER :: NBLX = 47 INTEGER(KIND=I4KIND), PARAMETER :: NBLY = 15 INTEGER(KIND=I4KIND), PARAMETER :: NBLM = NBLY - 1 INTEGER(KIND=I4KIND), PARAMETER :: LP1 = L + 1 INTEGER(KIND=I4KIND), PARAMETER :: LP2 = L + 2 INTEGER(KIND=I4KIND), PARAMETER :: LP3 = L + 3 INTEGER(KIND=I4KIND), PARAMETER :: LM1 = L - 1 INTEGER(KIND=I4KIND), PARAMETER :: LM2 = L - 2 INTEGER(KIND=I4KIND), PARAMETER :: LM3 = L - 3 INTEGER(KIND=I4KIND), PARAMETER :: LL = 2 * L INTEGER(KIND=I4KIND), PARAMETER :: LLP1 = LL + 1 INTEGER(KIND=I4KIND), PARAMETER :: LLP2 = LL + 2 INTEGER(KIND=I4KIND), PARAMETER :: LLP3 = LL + 3 INTEGER(KIND=I4KIND), PARAMETER :: LLM1 = LL - 1 INTEGER(KIND=I4KIND), PARAMETER :: LLM2 = LL - 2 INTEGER(KIND=I4KIND), PARAMETER :: LLM3 = LL - 3 INTEGER(KIND=I4KIND), PARAMETER :: LP1M = LP1 * LP1 INTEGER(KIND=I4KIND), PARAMETER :: LP1M1 = LP1M - 1 INTEGER(KIND=I4KIND), PARAMETER :: LP1V = LP1 * (1 + 2 * L / 2) INTEGER(KIND=I4KIND), PARAMETER :: LP121 = LP1 * NBLY INTEGER(KIND=I4KIND), PARAMETER :: LL3P = 3 * L + 2 INTEGER(KIND=I4KIND), PARAMETER :: NB = 12 INTEGER(KIND=I4KIND), PARAMETER :: INLTE = 3 INTEGER(KIND=I4KIND), PARAMETER :: INLTEP = INLTE + 1 INTEGER(KIND=I4KIND), PARAMETER :: NNLTE = 56 INTEGER(KIND=I4KIND), PARAMETER :: LP1I = IMAX * LP1 INTEGER(KIND=I4KIND), PARAMETER :: LLP1I = IMAX * LLP1 INTEGER(KIND=I4KIND), PARAMETER :: LL3PI = IMAX * LL3P INTEGER(KIND=I4KIND), PARAMETER :: NB1 = NB - 1 INTEGER(KIND=I4KIND), PARAMETER :: KO2 = 12 INTEGER(KIND=I4KIND), PARAMETER :: KO21 = KO2 + 1 INTEGER(KIND=I4KIND), PARAMETER :: KO2M = KO2 - 1 !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ INTEGER(KIND=I4KIND) ::& & IQ , ITOP , JTOP , IP , IR , J , I , K1 , K2 , & & KB , K , KP , KT , NC ! REAL (KIND=R4KIND) ::& & XCLD ! INTEGER(KIND=I4KIND), DIMENSION(IDIM1:IDIM2) , INTENT(IN) ::& & NCLDS ! INTEGER(KIND=I4KIND), DIMENSION(IDIM1:IDIM2, LP1) , INTENT(IN) ::& & KTOP , KBTM ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1) , INTENT(IN) ::& & CAMT ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, LP1, LP1) , INTENT(INOUT) ::& & CLDFAC ! REAL (KIND=R4KIND), DIMENSION(LP1) ::& & CLDROW ! REAL (KIND=R4KIND), DIMENSION(LP1, LP1, 64) ::& & CLDIPT ! DO 1 IQ=MYIS,MYIE,64 ITOP = IQ + 63 IF (ITOP > MYIE) ITOP = MYIE JTOP = ITOP - IQ + 1 DO 11 IP=1,JTOP IR = IQ + IP - 1 ! IF (NCLDS(IR) == 0) THEN DO 25 J=1,LP1 DO 25 I=1,LP1 CLDIPT(I,J,IP) = 1. 25 END DO END IF ! IF (NCLDS(IR) >= 1) THEN XCLD = 1. - CAMT(IR,2) K1 = KTOP(IR,2) + 1 K2 = KBTM(IR,2) ! DO 27 J=1,LP1 CLDROW(J) = 1. 27 END DO ! DO 29 J=1,K2 CLDROW(J) = XCLD 29 END DO ! KB = MAX(K1,K2+1) ! DO 33 K=KB,LP1 DO 33 KP=1,LP1 CLDIPT(KP,K,IP) = CLDROW(KP) 33 END DO ! DO 37 J=1,LP1 CLDROW(J) = 1. 37 END DO ! DO 39 J=K1,LP1 CLDROW(J) = XCLD 39 END DO ! KT = MIN(K1-1,K2) ! DO 43 K=1,KT DO 43 KP=1,LP1 CLDIPT(KP,K,IP) = CLDROW(KP) 43 END DO ! IF (K2+1 <= K1-1) THEN ! DO 31 J=K2+1,K1-1 DO 31 I=1,LP1 CLDIPT(I,J,IP) = 1. 31 END DO ! ELSE IF (K1 <= K2) THEN ! DO 32 J=K1,K2 DO 32 I=1,LP1 CLDIPT(I,J,IP) = XCLD 32 END DO ! END IF ! END IF ! IF (NCLDS(IR) >= 2) THEN DO 21 NC=2,NCLDS(IR) XCLD = 1. - CAMT(IR,NC+1) K1 = KTOP(IR,NC+1) + 1 K2 = KBTM(IR,NC+1) ! DO 47 J=1,LP1 CLDROW(J) = 1. 47 END DO ! DO 49 J=1,K2 CLDROW(J) = XCLD 49 END DO ! KB = MAX(K1,K2+1) ! DO 53 K=KB,LP1 DO 53 KP=1,LP1 CLDIPT(KP,K,IP) = CLDIPT(KP,K,IP) * CLDROW(KP) 53 END DO ! DO 57 J=1,LP1 CLDROW(J) = 1. 57 END DO ! DO 59 J=K1,LP1 CLDROW(J) = XCLD 59 END DO ! KT = MIN(K1-1,K2) DO 63 K=1,KT DO 63 KP=1,LP1 CLDIPT(KP,K,IP) = CLDIPT(KP,K,IP) * CLDROW(KP) 63 END DO ! IF (K1 <= K2) THEN DO 52 J=K1,K2 DO 52 I=1,LP1 CLDIPT(I,J,IP) = CLDIPT(I,J,IP) * XCLD 52 END DO END IF 21 END DO END IF ! 11 END DO ! DO 71 J=1,LP1 DO 71 I=1,LP1 DO 71 IP=1,JTOP IR = IQ + IP - 1 CLDFAC(IR,I,J) = CLDIPT(I,J,IP) 71 END DO ! 1 END DO ! RETURN ! END SUBROUTINE CLO89