SUBROUTINE SURGES(NOSFC) C C Version- 1.3 Date - 04/21/11 Programmer- A. Allegrino (IMSG) C C Version - 1.3 GETSFV now passes back an argument, IERROR. C C Version- 1.2 Date - 12/21/10 Programmer- A. Allegrino (IMSG) C C Version - 1.2 Added print statement to print surface values C C Version- 1.1 Date - 05/18/09 Programmer- A. Allegrino (IMSG) C C Version - 1.1 changed the integerization of the surface C pressure (PST) and added comments to may the C code more readable. C C $ SUBROUTINE SURGES(NOSFC) (CMH) C $ SURGEW - Expects to have /SURF/ filled with climatological values C $ IELV must be passed through /SURF/ C $ Get surface analysis for NOAA or VAS..Update surface C $ parameters C $ Input: C $ NOSFC = (I) IF =0 Get surface data fron grids C C $ Output: IZ10 (integer) 1000mb height C $ *NOTE: IZ10 is computed within GETSFV3.FOR C $ ITSFC (integer) sfc temperature * 100 C $ IDSFC (integer) sfc dewpoint * 100 C $ IPSTA (integer) sfc pressure (adjusted at the end?????) C $ LSTA (integer) # of 1st retrieval pressure level at or C above the surface C C $$ SURGES = VAS C N.B. GETSFV EXPECTS ANALYSES OF 1000 MB Z, SEA-LEVEL TEMPERATURE C AND SURFACE DEWPOINT DEPRESSION. VALUES RETURNED IN /SURF/ BY C THIS ROUTINE: 1000 Z (M), SURFACE TEMP AND SURFACE DEWPOINT(K*100) C CHARACTER*12 CFI,CFF CHARACTER*17 PN PARAMETER(PN=' (SURGES.FOR)') COMMON/SURF/IZ10,ITSFC,IDSFC,IPSTA,IELV,LSTA COMMON/NAV/VLAT,VLON,VZEN,SZEN,IL,IE,IRAS,IPIC,ITIME,JTIME,JDAY COMMON/DBUG/KBUG C C C Statement functions C FS2(I)=.01*FLOAT(I) IS2(F)=F*100.+.5 CALL SDEST(PN//'truc1 surges.for NOSFC = ',NOSFC) IF(NOSFC.EQ.1) GO TO 190 CALL SDEST(PN//'truc2 surges.for NOSFC = ',NOSFC) C C Get 2-D (space) interpolated values of 1000mb Z, C TSL * 100 and sfc DD * 100 C (from 3 sfc grids of 1000mb Z, TSL and sfc DD). C C NOTE: GETSFV.FOR only affects IZ10,ITSFC,IDSFC and C (if a problem) IPSTA. C CALL GETSFV(IERROR) IF(IERROR.NE.0) THEN IERROR = -99 CALL SDEST(PN// * 'ERROR returned from GETSFV.FOR ='// * CFI(IERROR)//' -- ABORT!',0) cxx * CFI(ISTAT)//' -- ABORT!',0) RETURN ELSE IF(IPSTA.EQ.999999) THEN CALL SDEST(PN// * 'NOTE: returned from GETSFV.FOR, IPSTA ='// * CFI(IPSTA)//' -- Return with IERROR='// * CFI(IERROR),0) RETURN ENDIF IDSFC=MAX0(IDSFC,0) IDSFC=MIN0(IDSFC,5000) IDSFC=ITSFC-IDSFC 190 CONTINUE C C Replace Mean Sea Level temperature and dewpoint with corresponding C surface values. C C TMSL=mean sea level temperature C DSFC= mean sea level dewpoint C DEW=mean sea level DD C Z10=1000mb height C ZS=sfc elevation (meters) C T10=1000mb temperature C DZ=difference between sfc elevation and 1000mb height C TSFC=surface temperature (by warming or cooling the 1000mb temperature) C ITSFC=essentially, NINT(surface temperature * 100.0) C TMSL=FS2(ITSFC) DSFC=FS2(IDSFC) DEW=TMSL-DSFC Z10=IZ10 ZS=IELV T10=TMSL-.0065*Z10 DZ=ZS-Z10 TSFC=T10-.0065*DZ ITSFC=IS2(TSFC) C C N.B. FOR NOSFC OPTION WE ARE APPLYING A 1000 MB AND NOT A SFC DEW C IF VALUES HAVE BEEN INITIALIZED BY VASGES C DSFC=TSFC-DEW IDSFC=IS2(DSFC) DEN=29.2898*TSFC+.0952*DZ IF(ABS(DEN).GT.1.E-6) GO TO 25 IPSTA=999999 RETURN 25 ARG=-DZ/DEN C C PST=Adjusted surface pressure C LSTA=Given surface pressure, get # of 1st retrieval pressure C level at or above it. C PST=1000.*EXP(ARG) IPSTA=NINT(PST) LSTA=LEVSFC(PST) IF(KBUG.GT.0) THEN CALL SDEST(PN//'T10='//CFF(DBLE(T10),4)// * ', DZ='//CFF(DBLE(DZ),4)// * ', TSFC='//CFF(DBLE(TSFC),4)// * ', ITSFC='//CFI(ITSFC)// * ', DSFC='//CFF(DBLE(DSFC),4)// * ', IDSFC='//CFI(IDSFC),0) CALL SDEST(PN//'DEN='//CFF(DBLE(DEN),8)// * ', PST='//CFF(DBLE(PST),4)// * ', IPSTA='//CFI(IPSTA)// * ', LSTA='//CFI(LSTA),0) ENDIF RETURN END