geosig.f

Go to the documentation of this file.

C*********************************************************************
        SUBROUTINE geosig
C*********************************************************************
C
C  PREPARE SFC STATION REPORTS OF WIND DIRECTION, WIND SPEED
C  (M/S), SEA LEVEL PRESSURE (MB), AND TEMPERATURE (DEG CELSIUS)
C  FOR INPUT TO WIND ANALYSIS IF NO UPPER WINDS.
C  COMPUTE GEOS WIND FROM PRESSURE AT THREE STATIONS AND
C  CORRECT IT FOR THERMAL WIND COMPONENT (IF DESIRED).
C
C  BY R M  ENDLICH, SRI INTN'L, MENLO PARK CA 94025 DEC '84.
C  VARIABLES.GEOSTROPHIC WIND CALCULATIONS WERE PUT IN THE SUBROUTINE
C  GEOSTR AND A  DIFFERENT METHOD OF WIND INTERPOLATION WAS INTRODUCED 
C  JANUARY 1988 BY F. LUDWIG.
C
C  FURTHER MODIFIED MAY 1989 TO REINTERPOLATE TO FLOW SURFACES WITH
C  SECOND CALLS TO DOPSIG, TOPWND, SFCTRP AND BETWIN --F. LUDWIG
C
C  FURTHER MODIFIED NOVEMBER 1989 TO INTERPOLATE SFC TEMPERATURES AND 
C  UPPER LEVEL POTENT TEMP LAPSE RATES TO FLOW SURFACES
C    -- F. LUDWIG
C
C  FURTHER MODIFIED MARCH 1997 TO READ A LONG SEQUENCE OF INPUTS FROM
C  THE SAME FILE (UNIT 12), NOT WINDS AND UPPER TEMPERATURES FROM 
C  SEPARATE FILES
C
C  FURTHER MODIFIED 12/01 TO READ DIFFERENT FORMAT AS USED WITH 
C  VTMX SLC DATA
C
C
C             -- F. LUDWIG  12/2001
C
C  VARIABLES:
C    NUMNWS = NUMBER OF SFC REPORTS
C    WD = WIND DIRECTION (DEG CW FROM N-- METEOROL CONVENT.)
C    SP = WIND SPEED (M/S)
C    STLT = STATION LATITUDE IN DEGS AND HUNDREDTHS
C    STLN = STATION LONGITUDE IN DEGS AND HUNDREDTHS
C    PRESS = STATION SEA LEVEL PRESSURE IN MB
C    TEMP = STATION TEMP IN DEG CELSIUS
C    SPDCNV=CONVERSION FACTOR TO CONVERT SPEEDS TO M/S, IF IN OTHER 
C           UNITS
C    DEG2R= FACTOR TO CONVERT DEGREES TO RADIANS
C
          include 'NGRIDS.PAR'
C
        parameter(pi=3.1415927,deg2r=pi/180.0)
C
          include 'ANCHOR.CMM'
          include 'FLOWER.CMM'
          include 'LIMITS.CMM'
          include 'STALOC.CMM'
C
       INTEGER NCALLZ
C
        SAVE
C
    DATA ncallz /0/
C
C  READ SURFACE STATION DATA: STATION ID, STATION COORDINATES (UTM)
C  PRESSURE, TEMPERATURE, WIND DIRECTION, WIND SPEED (MPS) 
C  READ NUMBER OF SFC OBS,NUMBER OF UPPER WIND SITES & NUMBER 
C  OF TEMP, PROFILES.  CHECK FOR ARRAY SIZES
C
    READ (12,*) numnws, numdop, numtmp
    IF (numnws.GT.nsites .OR. numnws.LT.1) THEN
           WRITE (*,*) 'BAD NUMBER OF SFC OBS'
           WRITE (*,*) numnws, ntsites
        END IF
    IF (numdop.GT.nwsite .OR. numdop.LT.1) THEN
           WRITE (*,*) 'BAD NUMBER OF WIND PROFILES'
           WRITE (*,*) numdop,nwsite
       stop
    END IF
    IF (numtmp.GT.ntsite .OR. numtmp.LT.1) THEN
           WRITE (*,*) 'BAD NUMBER OF TEMPERATURE PROFILES'
           WRITE (*,*) numtmp,ntsite
       stop
    END IF
C
C  SKIP COLUMN HEADINGS FOR SURFACE DATA
C
    READ (12,*)
C
C  READ SURFACE STATION DATA -- NEW FORMAT FOR SLC VTMX 12/01
C
    DO 75 it=1,numnws
       IF (it.LE.nsites) THEN
              READ (12,6004) chstid(it),xs,ys,zg(it),press,tempc(it),
     $                      wd,ws,ylat,xlong,tempf,pmsl,altim(it)
C
C  CONVERT PRESS ELEVATION INFO TO ALTIMETER SETTING, THIS FIXES THOSE
C  AUTOMATED SITES WHERE RELATIVE HUMITY IS GIVEN IN THE ALTIMETER 
C  SETTING DATA FIELD.
C
          IF (press.GT.0.0) THEN
             altim(it)=altset(zg(it),press)            
          ELSE
             altim(it)=-9999.0
          END IF
C
C  CONVERTING UTM COORDINATES (KM) AND ELEV. (M) TO GRID COORDINATES
C  (KM).   NOTE THAT ORIGIN IS AT POINT 1,1
C
          xg(it)=1.0+(xs-xorig)/dscrs
              yg(it)=1.0+(ys-yorig)/dscrs
          ixg=nint(xg(it))
          iyg=nint(yg(it))
C
C CONVERTING UNITS & GETTING COMPONENTS
C
           IF (ws .GE. -9998.9) THEN
          jgood(it)=.true.
                  ws=ws*spdcnv
                  ucomp(it)=-ws*sin(wd*deg2r)
                  vcomp(it)=-ws*cos(wd*deg2r)
               ELSE
          jgood(it)=.false.
                  ucomp(it)=-9999.0
                  vcomp(it)=-9999.0
               END IF
       END IF
75      CONTINUE
C
    ncallz=ncallz+1
C
C  INTERPOLATE TO LOWEST ABOVE GROUND GRID POINTS, USING SFC DATA.
C
    nsfc=1
        CALL sfctrp(nsfc)
C
C GET TOP WINDS BY INTERPOLATION BETWEEN UPPER SOUNDINGS IF AVAILABLE
C
        icall=1
        CALL dopsig (icall)
        CALL topwnd
C
C  READ TEMP PROFILE & GET LAPSE RATES AT FLOW LEVELS
C
        CALL strat
C
        CALL betwin
C
C  RESHAPE THE FLOW SURFACES USING THE 1ST ESTIMATE WINDS &
C  TEMPERATURE PROFILES.
C
        CALL resig
C
C  GO BACK AND REINTERPOLATE TO NEW SURFACES
C
C  -- THE FOLLOWING CODE ADDED MAY 1989 TO GIVE BETTER VALUES 
C     FOR 1ST GUESS FIELD, F. LUDWIG
C
        icall=2
C
        CALL dopsig(icall)
        CALL topwnd
    nsfc=2
        CALL sfctrp(nsfc)
        CALL betwin
C
        DO 350 j=1, nrow
           DO 325 i=1, ncol
              DO 300 lv=2,nlvl
C
C  WHEN RHS NEGATIVE (BELOW TERRAIN) MAKE WINDS 0.
C
                 IF (rhs(i,j,lv).LE.z0) THEN
                    u(i,j,lv)=0.0
                    v(i,j,lv)=0.0
                 END IF
300           CONTINUE
325        CONTINUE
350     CONTINUE
C      
6004    FORMAT (a5,12f10.2)
C
    RETURN
C
        END