output.f

Go to the documentation of this file.

C********************************************************************
    SUBROUTINE putout(CHDDHR,CHFNAM,MINJUL,NCALL)
C********************************************************************
C
C  WRITES OUTPUT FILES IN CM/SEC BINARY INTEGER FORM (DOBIN=.TRUE.), 
C  ONE FILE FOR EACH LEVEL OR ASCII FORM (DOBIN=.FALSE) -- ALSO INTEGER 
C  CM/SEC.  IF ASCII, GRID POINTS MAY BE SKIPPED.  FOR NSKIP=1, ALL
C  VALUES ARE WRITTEN, NSKIP =2, EVERY SECOND ROW AND COLUMN ETC.
C
C  AS OF 2/02, THE OUTPUT CODE WAS REVISED TO BE IN A SEPARATE 
C  SUBROUTINE AND TO INCLUDE THE OPTION OF PROVIDING FILES THAT GIVE 
C  WIND PROFILES AT UP TO 10 SEPARATE LOCATIONS.
C
C   FLUDWIG, 2/02
C
    include 'NGRIDS.PAR'
C
    include 'ANCHOR.CMM'
    include 'FLOWER.CMM'
    include 'LIMITS.CMM'
    include 'STALOC.CMM'
    include 'TSONDS.CMM'
C
        CHARACTER*2  CHPRO(nhoriz)
    CHARACTER*3  CHDIR,CHSPD,CHRIC
        CHARACTER*6  CHDDHR
    CHARACTER*12 CHFNAM
C
    INTEGER*4 NCALL,MINUTZ(111)
    INTEGER*4 IUTMP1(nxgrd,nygrd),IVTMP1(nxgrd,nygrd)
    INTEGER*4 IPTMP1(nxgrd,nygrd),ITTMP1(nxgrd,nygrd)
C
    LOGICAL DOTOPO
C
    SAVE
C
    DATA dotopo /.true./
    DATA chpro,chdir,chspd,chric /'01','02','03','04','05','06',
     $            '07','08','09','10','11','12','13','14','15','16',
     $            '17','18','19','20','21','22','23','24','25','26',
     $            '27', '28','29','30','DIR','SPD',' RI'/
C
    IF (ncall.GE.0) THEN
       minutz(ncall)=minjul
C      
       IF (dobin) THEN
C
C  BINARY OUTPUT FILES -- EACH COMPONENT IN SEPARATE FILE
C
C
C  HORIZONTAL COMPONENTS (CM/S)
C
C   WRITE (*,*) CHPVEX//'U'//CHMESH//'KM.'//CHDDHR
C
          OPEN(35,file='U'//chmesh//'KM.'//chddhr,
     $                     status='UNKNOWN')
C
          WRITE (35) iugraf  
          CLOSE (35)
C
          OPEN(35,file='V'//chmesh//'KM.'//chddhr,
     $                     status='UNKNOWN')
          WRITE (35) ivgraf
          CLOSE (35)
C
C  VERTICAL COMPONENT (CM/S)
C
          IF (dowcmp) THEN
             OPEN(35,file='W'//chmesh//'KM.'//chddhr,
     $                     form='UNFORMATTED', status='UNKNOWN')
C
             WRITE (35) iwgraf 
             CLOSE (35) 
          END IF
C
C  10*(POTENTIAL TEMPERATURE) K
C
          IF (dothet) THEN
             OPEN(35,file='PT'//chmesh//'KM.'//chddhr,
     $                     form='UNFORMATTED', status='UNKNOWN')
C
             WRITE (35) iptgrf
         CLOSE (35) 
          END IF
C
C  PRESSURE (MB, HP)
C
          IF (dopres) THEN
             OPEN(35,file='PR'//chmesh//'KM.'//chddhr,
     $                     form='UNFORMATTED', status='UNKNOWN')
C
             WRITE (35) iprgrf
         CLOSE (35)
          END IF
C
C  100*(BULK RICHARDSON NUMBER)
C
          IF (dobri) THEN
             OPEN(35,file='RI'//chmesh//'KM.'//chddhr,
     $                     form='UNFORMATTED', status='UNKNOWN')
C
             WRITE (35) irngrf
         CLOSE (35)
          END IF
C
          IF (dobvpd) THEN
             OPEN(35,file='BV'//chmesh//'KM.'//chddhr,
     $                     form='UNFORMATTED', status='UNKNOWN')
C
             WRITE (35) ibvgrf
         CLOSE (35)
          END IF
       ELSE
C
C  ASCII OUTPUT FILES
C
          IF (.NOT.dowvsz) THEN
C
C
C  GETTING FIELD OF OBSERVED U,V PRESS AND THETA -- 0 WHERE NO OBS
C
         CALL setint(0,iutmp1,nxgrd,nygrd)
         CALL setint(0,ivtmp1,nxgrd,nygrd)
         CALL setint(0,iptmp1,nxgrd,nygrd)
         CALL setint(0,ittmp1,nxgrd,nygrd)
C
C  FILL IN OBS WHERE AVAILABLE
C
         DO 115 iob=1,numnws
            IF (nint(ucomp(iob)) .NE. -9999) THEN
               kx=nint(xg(iob))
               ky=nint(yg(iob))
               IF (kx.GT.0 .AND. kx.LE. nxgrd 
     $                      .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
                  iutmp1(kx,ky)=nint(100.0*ucomp(iob))
                  ivtmp1(kx,ky)=nint(100.0*vcomp(iob))
               END IF
            END IF
            IF (nint(tempc(iob)).NE.-9999) THEN
               kx=nint(xg(iob))
               ky=nint(yg(iob))
               IF (kx.GT.0 .AND. kx.LE. nxgrd 
     $                      .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
                  IF (nint(altim(iob)) .NE. -9999) THEN
                 ppp=cvt2p(altim(iob),sfcht(kx,ky))
                  ELSE
                 ppp=float(iprgrf(kx,ky,1))
              END IF
                  ttt=tempc(iob)
                  ittmp1(kx,ky)=nint(10.0*tpot(ppp,ttt))
               END IF
            END IF
            IF (nint(altim(iob)).NE.-9999) THEN
               kx=nint(xg(iob))
               ky=nint(yg(iob))
               IF (kx.GT.0 .AND. kx.LE. nxgrd
     $                      .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
                  iptmp1(kx,ky)=
     $                         nint(cvt2p(altim(iob),sfcht(kx,ky)))
               END IF
            END IF
115      CONTINUE
C
C  THE FOLLOWING CODE IS DISABLED.  IT IS USED TO OUTPUT INPUT 
C  VALUES FOR COMPARISON WITH THE ANALYSIS
C***************************
    doobs=.false.
             IF (doobs) THEN
            WRITE (*,*) chpvex//'UFOBS'//chmesh//'KM-ALLZ.'//
     $                   chddhr
C
                OPEN (50,file='UFOBS'//chmesh//'KM-ALLZ.'//
     $                   chddhr,form='FORMATTED',status='UNKNOWN')
C
                OPEN (51,file='VFOBS'//chmesh//'KM-ALLZ.'//
     $                  chddhr,form='FORMATTED',status='UNKNOWN')
C
                    OPEN(40,file='PTOBS'//chmesh//'KM-ALLZ.'//
     $                   chddhr,form='FORMATTED',status='UNKNOWN')
C
                    OPEN(41,file='PROBS'//chmesh//'KM-ALLZ.'//
     $                  chddhr,form='FORMATTED',status='UNKNOWN')
C
                DO 68 iy=nascy0,nascy0-1+nryty,nskip
C
                   WRITE(50,6008) (iutmp1(ix,iy),
     $                         ix=nascx0,nascx0-1+nrytx,nskip)
                       WRITE(51,6008) (ivtmp1(ix,iy),
     $                         ix=nascx0,nascx0-1+nrytx,nskip)
                       WRITE(40,6008) (ittmp1(ix,iy),
     $                         ix=nascx0,nascx0-1+nrytx,nskip)
                       WRITE(41,6008) (iptmp1(ix,iy),
     $                         ix=nascx0,nascx0-1+nrytx,nskip) 
68              CONTINUE
             END IF
C
C***************************
C
             CLOSE (40)
             CLOSE (41)
             CLOSE (50)
             CLOSE (51)
C
C  WRITE TOPOGRAPHY AND GRIDDED OBSERVATIONS FOR THIS OUTPUT SET.
C  NORTHENMOST ROWS WRITTEN FIRST FOR PLOTTING PUPOSES WITH TRANSFORM.
C  
C
             WRITE(*,*) dotopo
             IF (dotopo) THEN
C
C               WRITE (*,*) CHPVEX//'LOCLTOPO'//CHMESH//'KM.DAT'
C
                OPEN(31,file=chpvex//'LOCLTOPO'//chmesh//'KM.DAT',
     $                   status='UNKNOWN')
C                       
                DO 168 iy=nascy0-1+nryty,nascy0,-nskip
                   WRITE(31,6008) (nint(sfcht(ix,iy)),
     $                       ix=nascx0,nascx0-1+nrytx,nskip)
168             CONTINUE
                CLOSE (31)
                dotopo=.false.
             END IF
C
C  IF NOT WRITING ASCII WIND PROFILE FILES, WRITE COMPONENTS FOR
C  EACH LEVEL AT EACH TIME.  WRITE TOPOGRAPHY AND GRIDDED OBSERVATIONS 
C  FOR THIS OUTPUT SET.  NORTHENMOST ROWS WRITTEN FIRST FOR PLOTTING 
C  PUPOSES WITH TRANSFORM.
C
C
             OPEN (46,file=chpvex//'UF'//
     $                 chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
C
             OPEN (47,file=chpvex//'VF'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
C
             IF (dowcmp) THEN
                    OPEN (35,file=chpvex//'WF'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                    status='UNKNOWN')
                 END IF
                                       
             IF (dothet) THEN
                    OPEN (36,file=chpvex//'PT'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
                 END IF
C
             IF (dopres) THEN
                    OPEN (37,file=chpvex//'PR'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
                 END IF
C
             IF (dobri) THEN
                OPEN (38,file=chpvex//'RIF'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
                 END IF

             IF (dobvpd) THEN
                    OPEN (39,file=chpvex//'BV'//
     $                   chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
     $                   status='UNKNOWN')
                 END IF
C
             DO 195 iz=1,nflat
C
                DO 185 iy=nascy0-1+nryty,nascy0,-nskip
C
               WRITE(46,6008) (iugraf(ix,iy,iz),
     $                       ix=nascx0,nascx0-1+nrytx,nskip)                          
               WRITE(47,6008) (ivgraf(ix,iy,iz),
     $                       ix=nascx0,nascx0-1+nrytx,nskip)
C
               IF (dowcmp) WRITE(35,6008) (iwgraf(ix,iy,iz), 
     $                       ix=nascx0,nascx0-1+nrytx,nskip)
C
               IF (dothet) WRITE(36,6008) (iptgrf(ix,iy,iz),
     $                         ix=nascx0,nascx0-1+nrytx,nskip)
C
               IF (dopres) WRITE(37,6008) (iprgrf(ix,iy,iz),
     $                          ix=nascx0,nascx0-1+nrytx,nskip)
C
               IF (dobri) WRITE(38,6008) (irngrf(ix,iy,iz),
     $                          ix=nascx0,nascx0-1+nrytx,nskip)
C
               IF (dobvpd) WRITE(39,6008) (ibvgrf(ix,iy,iz),
     $                          ix=nascx0,nascx0-1+nrytx,nskip)
C
185             CONTINUE
195          CONTINUE
             CLOSE (46)
             CLOSE (47)
             IF (dowcmp) CLOSE (35)
             IF (dothet) CLOSE (36)
             IF (dopres) CLOSE (37)
             IF (dobri)  CLOSE (38)
             IF (dobvpd) CLOSE (39)
C
          ELSE
C
C  FILL ARRAYS FOR PROFILE  FILES
C
             DO 150 ip=1,npfyls
            ipx=jprylx(ip)
            ipy=jpryly(ip)
            DO 140 ll=1,nflat
               iuprf(ip,ll,ncall)=iugraf(ipx,ipy,ll)
               ivprf(ip,ll,ncall)=ivgraf(ipx,ipy,ll)
               riprf(ip,ll,ncall)=float(irngrf(ipx,ipy,ll))                       
140         CONTINUE
150          CONTINUE
C            
          END IF
C            
       END IF
    ELSE
C*************DISABLED CODE**************
C   IF DOING WIND PROFILES, WE ARE DONE CALCULATING AND STORING, NOW 
C   WRITE  
C
       DO 175 ip=1,npfyls
          OPEN(46,file=chpvex//'WNDPROF'//chpro(ip),
     $              form='FORMATTED', status='UNKNOWN')
C
C  WRITE WIND PROFILES (ROW) VS TIME (COL)
C
              WRITE (46,6004) (chdir,chpro(ii),chspd,
     $                    chpro(ii),chric,chpro(ii),ii=1,-ncall)
              DO 170 iz=1,nflat
             WRITE (46,6006) zchooz(iz),
     $              (dd(float(iuprf(ip,iz,it)),float(ivprf(ip,iz,it))),
     $               0.01*sp(float(iuprf(ip,iz,it)),
     $               float(ivprf(ip,iz,it))),
     $               1000.*riprf(ip,iz,it),it=1,-ncall)
170       CONTINUE
175    CONTINUE
       CLOSE (46)
C
C  WRITE WIND TIME SERIES (COL) VS HEIGHT (ROW)
C
       DO 275 ip=1,npfyls
          OPEN(47,file=chpvex//'WNDTSER'// chpro(ip),
     $             form='FORMATTED', status='UNKNOWN')
              WRITE (47,6005) (chdir,chpro(ii),
     $                   chspd,chpro(ii),chric,chpro(ii),ii=1,nflat)
          
              DO 270 it=1,-ncall
             WRITE (47,6007) minutz(it),
     $             (dd(float(iuprf(ip,iz,it)),float(ivprf(ip,iz,it))),
     $              0.01*sp(float(iuprf(ip,iz,it)),
     $                          float(ivprf(ip,iz,it))),
     $                              1000.*riprf(ip,iz,it),iz=1,nflat)
270       CONTINUE
275    CONTINUE
       CLOSE (47)
C*******************END DISABLED CODE*************************
    END IF
C
    WRITE(*,*) ' FINISHED ',chfnam
C
    CLOSE (12)
C
6004    FORMAT (1x,'  MSL ',55(1x,a3,a2,1x,a3,a2,1x,a3,a2))
6005    FORMAT (1x,'   MIN  ',55(1x,a3,a2,1x,a3,a2,1x,a3,a2))
6006    FORMAT (1x,f6.0,55(f6.0,2f6.1))
6007    FORMAT (1x,i8,55(f6.0,2f6.1))
6008    FORMAT (1x,111i6)
C
    RETURN
C
    END