PROGRAM MAKBND C$$$ MAIN PROGRAM DOCUMENTATION BLOCK C . . . . C MAIN PROGRAM: MKBND126 CREATE values along boundaries of ngm/eta C PRGMMR: ROGERS ORG: NP22 DATE: 1998-10-19 C C ABSTRACT: READS IN spectral COEFFICIENT FORM (KMAX LEVELS OF C T126 COEFFICIENTS) AND CONVERTS IT TO A IMAX X JMAX "basis" grid C for interpolation to the boundary points of the NGM or ETA models C C PROGRAM HISTORY LOG: C 90-05-21 DIMEGO/PAN CRAY CODE WITH A NEW C SUBROUTINE INTERFACE FOR TRANSFORMS C 99-02-05 ROGERS GENERALIZED VERSION WHICH WILL WORK C FOR ANY GLOBAL MODEL RESOLUTION C ADDED PTETABC CODE (INTERPOLATES ETA C BOUNDARY POINTS FROM SIGMA TO ETA) C AS A SUBROUTINE C USAGE: C INPUT FILES: C UNIT11 - sigma COEFFICIENTS FROM THE GDAS or aviation C - ON KMAX SIGMA LEVELS C C OUTPUT FILES: C UNIT6 - DIAGNOSTICS AND PRINT OUTPUT C UNIT90 - output FILE OF lateral boundary values C C SUBPROGRAMS CALLED: C UNIQUE: - COF2GRD COF2xx DZTOUV PPZT PPUV C CMPIND CMPWND TRANSI TRANVI C PLN2H SUMSHS SUMVHS FFTidim C C LIBRARY: C SPLIB - SPTRAN SPTRANV C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C C REMARKS: SEE COMMENT CARDS FOLLOWING DOCBLOCK C C ATTRIBUTES: C LANGUAGE: STANDARD FORTRAN C MACHINE: C C$$$ CC C VARIABLES IN NAMELIST RGRID READ INTO MAIN PROGRAM CC C POLA - TYPE OF baSIS GRID (DEFAULT=FALSE) C NORTH - HEMISPHERE SWITCH FOR baSIS GRID (DEFAULT=TRUE) C ALONVT - REFERENCE LONGITUDE (+W) FOR POLA = TRUE C STARTING LATITUDE (+N) FOR POLA = FALSE C POLEI - I INDEX OF POLE FOR POLA = TRUE C INCREMENT FOR LATITUDE FOR POLA = FALSE C POLEJ - J INDEX OF POLE FOR POLA = TRUE C STARTING LONGITUDE (+W) FOR POLA = FALSE GRNWCH=360 C XMESHL - MESH LENGTH (KM) AT 60N FOR POLA = TRUE C INCREMENT FOR LONGITUDE FOR POLA = FALSE C SI2 - LMAXP1 SIGMA INTERFACE DEFINITIONS CC C C ASSUME MAXIMUM # GLOBAL LEVELS = 50 C INCLUDE "parmlbc" C----------------------------------------------------------------------- D I M E N S I O N & HPTLAT(KB), HPTLON(KB), UPTLAT(KB), UPTLON(KB) &,VPTLAT(KB), VPTLON(KB) C D I M E N S I O N & UATHPTS(KB,KMAX), VATHPTS(KB,KMAX), & TATHPTS(KB,KMAX), QATHPTS(KB,KMAX), & PSATHPTS(KB), ZSATHPTS(KB), & UATUPTS(KB,KMAX), VATUPTS(KB,KMAX), TATUPTS(KB,KMAX), & PSATUPTS(KB), ZSATUPTS(KB), & UATVPTS(KB,KMAX), VATVPTS(KB,KMAX), TATVPTS(KB,KMAX), & PSATVPTS(KB), ZSATVPTS(KB) DIMENSION ALL(245) C DIMENSION XX(IMAX,JMAX,KMAX,4) DIMENSION TEMP(IMAX,JMAX,KMAX),QTEMP(IMAX,JMAX,KMAX) DIMENSION SI(KMAX+1),SL(KMAX),IDATE(4) DIMENSION PS(IMAX,JMAX,3) C PARAMETER(IDIM=IMAX,JDIM=JMAX, 1 NVAR=4,NPOINT=3) C DIMENSION TMN0(KMAX), AREA(KMAX) C COMMON /SIGLTB/ B(LBDIM,KMAX,NVAR,NPOINT),GLON(LBDIM,NPOINT) 1 ,SLVL(KMAX+1),SLYR(KMAX),PSFC(LBDIM,NPOINT),ZSFC(LBDIM,NPOINT) 2 ,DTMN(KMAX) C EQUIVALENCE (SI(1),SLVL(1)) EQUIVALENCE (SL(1),SLYR(1)) EQUIVALENCE (GLON(1,1),UPTLON(1)) EQUIVALENCE (GLON(1,2),VPTLON(1)) EQUIVALENCE (GLON(1,3),HPTLON(1)) EQUIVALENCE (PSFC(1,1),PSATUPTS(1)) EQUIVALENCE (PSFC(1,2),PSATVPTS(1)) EQUIVALENCE (PSFC(1,3),PSATHPTS(1)) EQUIVALENCE (ZSFC(1,1),ZSATUPTS(1)) EQUIVALENCE (ZSFC(1,2),ZSATVPTS(1)) EQUIVALENCE (ZSFC(1,3),ZSATHPTS(1)) EQUIVALENCE (B(1,1,1,1),UATUPTS(1,1)) EQUIVALENCE (B(1,1,2,1),VATUPTS(1,1)) EQUIVALENCE (B(1,1,3,1),TATUPTS(1,1)) EQUIVALENCE (B(1,1,1,2),UATVPTS(1,1)) EQUIVALENCE (B(1,1,2,2),VATVPTS(1,1)) EQUIVALENCE (B(1,1,3,2),TATVPTS(1,1)) EQUIVALENCE (B(1,1,1,3),UATHPTS(1,1)) EQUIVALENCE (B(1,1,2,3),VATHPTS(1,1)) EQUIVALENCE (B(1,1,3,3),TATHPTS(1,1)) EQUIVALENCE (B(1,1,4,3),QATHPTS(1,1)) C LOGICAL POLA,NORTH COMMON /GRID/ POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL NAMELIST/RGRID/POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL EQUIVALENCE (YLATS,ALONVT) , (DLAT,POLEI) EQUIVALENCE (XLONW,POLEJ) , (DLON,XMESHL) C NAMELIST/PRMFLD/NTIMES C DIMENSION CON(24),XLIM(4),YLIM(4) CHARACTER*4 YTITLE(20) , BLANK LOGICAL IACROS,XREV,YREV,TICK,ALLCON CHARACTER*1 XTITLE(30) , BLNK DATA BLANK/' '/ , BLNK/' '/ COMMON /BLK3/ MI,LJ,LID,IACROS,XREV,YREV,TICK,ALLCON,XLIM,YLIM, + XRG,YRG,IXD,IYD,NPRL,NPRC,NLV,CON,XTITLE,YTITLE C COMMON /GRIDS/ ALAT( IMAX , JMAX ),ALON( IMAX , JMAX ) C CALL W3TAGB('MKBND ',1998,0292,0082,'NP22 ') print*,'start of mkbnd' C WRITE(6,1) 1 FORMAT('1 WELCOME TO THE GENERAL BOUNDARY VALUE PROCESSOR',/, + ' WITH NEW TRANSFORMs -ETA/NGM- CRAY VERSION December 6,1990',//) MI = IMAX LID = MI LJ = JMAX DO I=1,30 XTITLE(I) = BLNK ENDDO DO I=1,20 YTITLE(I) = BLANK ENDDO C C YC=NPRC/IMAX and XC=NPRL/JMAX C THESE ARE FOR half grid NPRC=68 and NPRL=41 small screen C YC = (68.) / FLOAT(IMAX) XL = (41.) / FLOAT(JMAX) CON(1) = 1.0 CON(2) = 1.0 ICT = 3 DEGRAD = 3.14159265 / 180. C C SET PRINT FOR 12 VALUES PER LINE C ISIX = IMAX / 12 + 1 C NAMELIST/RGRID/POLA,NORTH,ALONVT,POLEI,POLEJ,XMESHL c LOGICAL POLA,NORTH POLA = .FALSE. NORTH = .TRUE. ALONVT = 0.5 POLEI = 1.0 POLEJ = 360. XMESHL = 1.0 READ(5,RGRID) WRITE(6,4)ALONVT,POLEI,POLEJ,XMESHL 4 FORMAT('0 &RGRID LIMITS ',4G12.5) NTIMES = 1 READ(5,PRMFLD) WRITE(6,PRMFLD) NUNIT = 90 C IF( KBETA.NE.KB ) & CALL ngmPTS(HPTLAT,HPTLON,NHPT, & UPTLAT,UPTLON,NUPT, & VPTLAT,VPTLON,NVPT, & NTIMES,NUNIT,DLAM0) C IF( KBETA.EQ.KB ) & CALL etaPTS(HPTLAT,HPTLON,NHPT, & UPTLAT,UPTLON,NUPT, & VPTLAT,VPTLON,NVPT) C DO 9800 NT = 1,NTIMES IFCTHR = (NT-1) * 6 ITIME = (IFCTHR-12) * 3600 C C READ and process the SIGGES COEFFICIENTS C FIRST READ THE SECOND RECORD TO GET GLOBAL MODEL C SPECS WHICH ARE SENT TO THE COF2GRD ROUTINE C LUN1= 11 + (NT -1) write(*,*) '>>going to read sigma unit=',lun1 READ(LUN1) READ(LUN1)HOUR,IDATE,SI,SL write(*,*) '<