1 2 SUBROUTINE METSUM 3 !*********************************************************************** 4 ! METSUM Module of ISC3 Short Term Model - ISCST3 5 ! 6 ! PURPOSE: Print Out The Summary Of The Meteorology Data 7 ! Sampled Using the SCIM Option 8 ! 9 ! PROGRAMMER: Roger Brode, PES, Inc. 10 ! 11 ! DATE: April 14, 1998 12 ! 13 ! MODIFIED: To output missing temperatures correctly in the 14 ! SCIM met data file. 15 ! R.W. Brode, PES, Inc., - 02/25/02 16 ! 17 ! INPUTS: Meteorology Input Data 18 ! 19 ! OUTPUTS: Printed Model Outputs 20 ! 21 ! CALLED FROM: HRLOOP 22 !*********************************************************************** 23 24 ! Variable Declarations 25 USE MAIN1 26 IMPLICIT NONE 27 CHARACTER MODNAM*12 28 29 SAVE 30 REAL :: PFLTEMP 31 INTEGER :: I , ILMAX 32 33 ! Variable Initializations 34 MODNAM = 'METSUM' ! 0 35 36 ! WRITE Out Header Information 37 IF ( ILINE.EQ.IFIRSTHR ) THEN 38 ! Write Surface Data 39 WRITE (ISUNIT,9011) ! 0 40 41 9011 FORMAT (/1X,'*** SUMMARY OF THE SAMPLED SURFACE ', & 42 & 'METEOROLOGICAL DATA USED WITH THE SCIM OPTION ***'/) 43 ILMAX = MIN(80,ILEN_FLD) 44 WRITE (ISUNIT,9016) METINP(1:ILMAX) , METFRM 45 9016 FORMAT (1X,'Surface file: ',A80,/,1X,'Surface format: ',A105) 46 WRITE (ISUNIT,9020) IDSURF , IDUAIR , SFNAME , UANAME , & 47 & ISYEAR , IUYEAR 48 9020 FORMAT (1X,'SURFACE STATION NO.: ',I6,20X, & 49 & 'UPPER AIR STATION NO.: ',I6/16X,'NAME: ',A40,3X, & 50 & 'NAME: ',A40/16X,'YEAR: ',I6,37X,'YEAR: ',I6/) 51 WRITE (ISUNIT,9025) 52 9025 FORMAT (' YR',' MO',' DY',' JDY',' HR',' H0',' U*', & 53 & ' W*',' DT/DZ',' ZICNV',' ZIMCH',' M-O LEN', & 54 & ' Z0',' BOWEN',' ALBEDO',' REF WS',' WD', & 55 & ' HT',' REF TA',' HT',/60(' -')) 56 57 ! Write Profile Data 58 WRITE (IPUNIT,99011) 59 60 99011 FORMAT (/1X,'*** SUMMARY OF THE SAMPLED PROFILE ', & 61 & 'METEOROLOGICAL DATA USED WITH THE SCIM OPTION ***'/) 62 ILMAX = MIN(80,ILEN_FLD) 63 WRITE (IPUNIT,99016) PROINP(1:ILMAX) , PROFRM 64 99016 FORMAT (1X,'Profile file: ',A80,/,1X,'Profile format: ',A105) 65 WRITE (IPUNIT,99020) IDSURF , IDUAIR , SFNAME , UANAME , & 66 & ISYEAR , IUYEAR 67 99020 FORMAT (1X,'SURFACE STATION NO.: ',I6,20X, & 68 & 'UPPER AIR STATION NO.: ',I6/16X,'NAME: ',A40,3X, & 69 & 'NAME: ',A40/16X,'YEAR: ',I6,37X,'YEAR: ',I6/) 70 WRITE (IPUNIT,99025) 71 99025 FORMAT (' YR',' MO',' DY',' HR',' HEIGHT',' F',' WDIR', & 72 & ' WSPD',' AMB_TMP',' sigmaA',' sigmaW',/29(' -')) 73 ENDIF 74 75 WRITE (ISUNIT,9026) IYEAR , IMONTH , IDAY , JDAY , IHOUR , SFCHF ,& 76 & USTAR , WSTAR , VPTGZI , ZICONV , ZIMECH , & 77 & OBULEN , SFCZ0 , BOWEN , ALBEDO , UREF , & 78 & WDREF , UREFHT , TA , TREFHT 79 9026 FORMAT (1X,3(I2.2,1X),I3,1X,I2.2,1X,F6.1,1X,3(F6.3,1X),2(F5.0,1X),& 80 & F8.1,1X,F5.2,1X,2(F6.2,1X),F7.2,1X,F5.0,3(1X,F6.1)) 81 82 DO I = 1 , NPLVLS 83 IF ( PFLTA(I).EQ.-999.0 ) THEN ! 0 84 PFLTEMP = PFLTA(I) ! 0 85 ELSE 86 PFLTEMP = PFLTA(I) - DCTODK ! 0 87 ENDIF 88 WRITE (IPUNIT,99026) KYEAR , KMONTH , KDAY , KHOUR , PFLHT(I) ,& 89 & IFLAG(I) , PFLWD(I) , PFLWS(I) , PFLTEMP ,& 90 & PFLSW(I) , PFLSV(I) 91 99026 FORMAT (1X,4(I2.2,1X),F6.1,1X,I1,1X,F5.0,1X,F7.2,1X,F7.1,1X, & 92 & F6.1,1X,F7.2) 93 ENDDO 94 95 96 CONTINUE ! 0 97 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use