SUBROUTINE CONRAD(NFILE) !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE CONRAD !> !> SUBROUTINE: CONRAD - READ CO2 TRANSMISSION DATA FROM UNIT(NFILE) FOR NEW VERTICAL COORDINATE !> TESTS THESE ARRAYS USED TO BE IN BLOCK DATA. !> PROGRAMMER: K.CAMPANA !> ORG: ????? !> DATE: 90-03-?? !> !> ABSTRACT: !> CO2 DATA TABLES FOR USER'S VERTICAL COORDINATE. !> !> THE FOLLOWING COMMON BLOCKS CONTAIN PRETABULATED CO2 TRANSMISSION FUNCTIONS, EVALUATED USING THE !> METHODS OF FELS AND SCHWARZKOPF (1981) AND SCHWARZKOPF AND FELS (1985). !> THE 2-DIMENSIONAL ARRAYS ARE CO2 TRANSMISSION FUNCTIONS AND THEIR DERIVATIVES FROM 109-LEVEL !> LINE-BY-LINE CALCULATIONS MADE USING THE 1982 MCCLATCHY TAPE (12511 LINES), CONSOLIDATED, !> INTERPOLATED TO THE NMC MRF VERTICAL COORDINATTE, AND RE-CONSOLIDATED TO A 200 CM-1 BANDWIDTH. !> THE INTERPOLATION METHOD IS DESCRIBED IN SCHWARZKOPF AND FELS (J.G.R., 1985). !> !> THE 1-DIM ARRAYS ARE CO2 TRANSMISSION FUNCTIONS AND THEIR DERIVATIVES FOR TAU(I,I+1), I=1, L, !> WHERE THE VALUES ARE NOT OBTAINED BY QUADRATURE,BUT ARE THE ACTUAL TRANSMISSIVITIES, ETC, !> BETWEEN A PAIR OF PRESSURES. !> THESE USED ONLY FOR NEARBY LAYER CALCULATIONS INCLUDING QH2O. !> !> THE WEIGHTING FUNCTION GTEMP = P(K) ** 0.2 * (1. + P(K) / 30000.) ** 0.8 / 1013250., !> WHERE P(K) = PRESSURE, NMC MRF(NEW) L18 DATA LEVELS FOR PSTAR = 1013250. !> !> STEMP IS US STANDARD ATMOSPHERES, 1976, AT DATA PRESSURE LEVELS USING NMC MRF SIGMAS, !> WHERE PSTAR = 1013.25 MB (PTZ PROGRAM) !> !> MODULE CO2BD3 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE AND PRESSURE DERIVATIVES FOR !> THE 560-800 CM-1 BAND. !> ALSO INCLUDED ARE THE STANDARD TEMPERATURES AND THE WEIGHTING FUNCTION. THESE DATA ARE IN BLOCK !> DATA BD3: !> !> CO251 - TRANSMISSION FCTNS FOR T0 (STD. PROFILE) WITH P(SFC)=1013.25 MB !> CO258 - TRANSMISSION FCTNS. FOR T0 (STD. PROFILE)WITH P(SFC)= 810 MB !> CDT51 - FIRST TEMPERATURE DERIVATIVE OF CO251 !> CDT58 - FIRST TEMPERATURE DERIVATIVE OF CO258 !> C2D51 - SECOND TEMPERATURE DERIVATIVE OF CO251 !> C2D58 - SECOND TEMPERATURE DERIVATIVE OF CO251 !> CO2M51 - TRANSMISSION FCTNS FOR T0 FOR ADJACENT PRESSURE LEVELS, WITH NO PRESSURE QUADRATURE. !> USED FOR NEARBY LAYER COMPUTATIONS. P(SFC)=1013.25 MB !> CO2M58 - SAME AS CO2M51,WITH P(SFC)= 810 MB !> CDTM51 - FIRST TEMPERATURE DERIVATIVE OF CO2M51 !> CDTM58 - FIRST TEMPERATURE DERIVATIVE OF CO2M58 !> C2DM51 - SECOND TEMPERATURE DERIVATIVE OF CO2M51 !> C2DM58 - SECOND TEMPERATURE DERIVATIVE OF CO2M58 !> STEMP - STANDARD TEMPERATURES FOR MODEL PRESSURE LEVEL STRUCTURE WITH P(SFC)=1013.25 MB !> GTEMP - WEIGHTING FUNCTION FOR MODEL PRESSURE LEVEL STRUCTURE WITH P(SFC)=1013.25 MB. !> !> THE FOLLOWING ARE STILL IN BLOCK DATA !> !> B0 - TEMP. COEFFICIENT USED FOR CO2 TRANS. FCTN. CORRECTION FOR T(K). (SEE REF. 4 AND BD3) !> B1 - TEMP. COEFFICIENT, USED ALONG WITH B0 !> B2 - TEMP. COEFFICIENT, USED ALONG WITH B0 !> B3 - TEMP. COEFFICIENT, USED ALONG WITH B0 !> !> PROGRAM HISTORY LOG: !> 00-01-20 K.CAMPANA - 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: !> NFILE - !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: CO2DTA !> F77KINDS !> GLB_TABLE !> MAPPINGS !> MPPCOM !> PARMETA !> TEMPCOM !> TOPO !> !> DRIVER : GRADFS !> !> CALLS : MPI_BCAST !> TABLE !>-------------------------------------------------------------------------------------------------- USE CO2DTA USE F77KINDS USE GLB_TABLE USE MAPPINGS USE MPPCOM USE PARMETA USE TEMPCOM USE TOPO ! IMPLICIT NONE ! INCLUDE "mpif.h" ! #include "sp.h" ! INTEGER(KIND=I4KIND), PARAMETER :: IX = 2 * IM - 1 INTEGER(KIND=I4KIND), PARAMETER :: KX = LM INTEGER(KIND=I4KIND), PARAMETER :: KP = KX + 1 INTEGER(KIND=I4KIND), PARAMETER :: LP12 = LP1 * LP1 !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND), DIMENSION(LP1, 2) ::& & SGTMP ! REAL (KIND=R4KIND), DIMENSION(L, 6) ::& & CO21D ! REAL (KIND=R4KIND), DIMENSION(LP1, LP1, 6) ::& & CO22D ! REAL (KIND=R4KIND), DIMENSION(LP1, 6) ::& & CO21D3 , CO21D7 ! REAL (KIND=R4KIND), DIMENSION(LP12) ::& & DATA2 ! INTEGER(KIND=I4KIND), DIMENSION(3) ::& & RSZE ! INTEGER(KIND=I4KIND) ::& & RSIZE , KK , I , IRTN , N , I1 , I2 , K , J ! INTEGER(KIND=I4KIND) , INTENT(IN) ::& & NFILE !--------------------------------------------------- ! THE ABOVE NOT USED IN CURRENT VERSION OF RADIATION ! ! BEGIN HERE TO GET CONSTANTS FOR RADIATION PACKAGE !--------------------------------------------------- OPEN(UNIT=NFILE,FORM='UNFORMATTED',FILE='CO2.dat') ! REWIND NFILE !---------------------------------------------------------------------- ! READ IN PRE-COMPUTED CO2 TRANSMISSION DATA AND CONVERT TO CYBER WORDS !---------------------------------------------------------------------- RSZE(1) = LP1 RSZE(2) = L RSZE(3) = LP1 * LP1 ! RSIZE = RSZE(1) DO 10 KK=1,2 IF (MYPE == 0) READ(NFILE) (SGTMP(I,KK),I=1,RSIZE) CALL MPI_BCAST(SGTMP(1,KK), RSIZE, MPI_REAL, 0, MPI_COMM_COMP, IRTN) 10 END DO ! RSIZE = RSZE(2) DO 15 KK=1,6 IF (MYPE == 0) READ(NFILE) (CO21D(I,KK),I=1,RSIZE) CALL MPI_BCAST(CO21D(1,KK), RSIZE, MPI_REAL, 0, MPI_COMM_COMP, IRTN) 15 END DO ! RSIZE = RSZE(3) DO 20 KK=1,6 IF (MYPE == 0) READ(NFILE) (DATA2(I),I=1,RSIZE) CALL MPI_BCAST(DATA2(1), RSIZE, MPI_REAL, 0, MPI_COMM_COMP, IRTN) ! N = 0 DO 5673 I1=1,LP1 DO 5673 I2=1,LP1 N = N + 1 CO22D(I1,I2,KK) = DATA2(N) 5673 END DO 20 END DO ! RSIZE = RSZE(1) DO 25 KK=1,6 IF (MYPE == 0) READ(NFILE) (CO21D3(I,KK),I=1,RSIZE) CALL MPI_BCAST(CO21D3(1,KK), RSIZE, MPI_REAL, 0, MPI_COMM_COMP, IRTN) 25 END DO ! DO 30 KK=1,6 IF (MYPE == 0) READ(NFILE) (CO21D7(I,KK),I=1,RSIZE) CALL MPI_BCAST(CO21D7(1,KK), RSIZE, MPI_REAL, 0, MPI_COMM_COMP, IRTN) 30 END DO ! REWIND NFILE ! DO 35 K=1,LP1 STEMP(K) = SGTMP(K,1) GTEMP(K) = SGTMP(K,2) 35 END DO ! DO 40 K=1,L CDTM51(K) = CO21D(K,1) CO2M51(K) = CO21D(K,2) C2DM51(K) = CO21D(K,3) CDTM58(K) = CO21D(K,4) CO2M58(K) = CO21D(K,5) C2DM58(K) = CO21D(K,6) 40 END DO ! DO 45 J=1,LP1 DO 45 I=1,LP1 CDT51(I,J) = CO22D(I,J,1) CO251(I,J) = CO22D(I,J,2) C2D51(I,J) = CO22D(I,J,3) CDT58(I,J) = CO22D(I,J,4) CO258(I,J) = CO22D(I,J,5) C2D58(I,J) = CO22D(I,J,6) 45 END DO ! DO 50 K=1,LP1 CDT31(K) = CO21D3(K,1) CO231(K) = CO21D3(K,2) C2D31(K) = CO21D3(K,3) CDT38(K) = CO21D3(K,4) CO238(K) = CO21D3(K,5) C2D38(K) = CO21D3(K,6) 50 END DO ! DO 55 K=1,LP1 CDT71(K) = CO21D7(K,1) CO271(K) = CO21D7(K,2) C2D71(K) = CO21D7(K,3) CDT78(K) = CO21D7(K,4) CO278(K) = CO21D7(K,5) C2D78(K) = CO21D7(K,6) 55 END DO ! IF (MYPE == 0) PRINT 66, NFILE 66 FORMAT(1H ,'----READ CO2 TRANSMISSION FUNCTIONS FROM UNIT ',I2) !------------------------------- ! DEFINE TABLES FOR LW RADIATION !------------------------------- CALL TABLE ! RETURN ! END SUBROUTINE CONRAD