get_postfilename.f

      subroutine get_postfilename(fname)
!
! ABSTRACT: THIS SUBROUTINE GENERATE POST FILE NAME FROM THE DATSET IN
!           POST CONTROL FILE
!
!  Program log:
!     11-02        Jun Wang   generate code from subroutine gribit
!
      use ctlblk_mod,  only : ifhr, me, modelname, ifmin
      use rqstfld_mod, only : ritehd, datset, iget
!
      implicit none
!
      character(*),intent(inout) :: fname
!
!local vars
      integer IHR,KDAT,KENV,KTHR,NDIG
      CHARACTER*4  RESTHR,BLANK
      CHARACTER*10  DESCR2,DESCR3
      character CFHOUR*40,CFORM*40
      CHARACTER*180 ENVAR
      CHARACTER*255 PGBOUT,IPVOUT,D3DOUT
!
      DATA blank /'    '/
!
      IF (ritehd) THEN
!
!        PUT FORECAST HOUR INTO DIR PREFIX FOR GRIB FILE.
         ihr = ifhr
!
!        GET FULL PATH FOR OUTPUT FILE FROM ENVIRONMENT VARIABLE
!        COMSP WHICH IS SET IN THE SCRIPT RUNNING THE MODEL.
!
!        CONSTRUCT FULL PATH-FILENAME FOR OUTPUT FILE
         envar = ' '
         resthr = ' '
         pgbout = ' '
         ipvout = ' '
         d3dout = ' '
         CALL getenv('COMSP',envar)
         CALL getenv('tmmark',resthr)
         CALL getenv('PGBOUT',pgbout)
         CALL getenv('IPVOUT',ipvout)
         CALL getenv('D3DOUT',d3dout)
         kdat = index(datset,' ') -1
         IF (kdat<=0) kdat = len(datset)
         kenv = index(envar,' ') -1
         IF (kenv<=0) kenv = len(envar)
         kthr = index(resthr,' ') -1
         IF (kthr<=0) kthr = len(resthr)
         if(me==0) print *,'PGBOUT=',trim(pgbout)
!
      if(me==0)print *,'in get postfilename, ritehd=',ritehd,'ifhr=',ifhr,'modelname=',modelname, &
        'ENVAR(1:4)=',envar(1:4),'RESTHR(1:4)=',resthr(1:4),'ifmin=',ifmin,'DATSET(1:KDAT)=', &
        datset(1:kdat)
!
!        CONSTRUCT FULL PATH-FILENAME FOR OUTPUT FILE
         IF(modelname=='GFS')THEN
          IF(d3dout(1:4)/=blank .AND. &
             ((iget(354)>0).OR.(iget(355)>0).OR.  &
             (iget(356)>0).OR.(iget(357)>0).OR.  &
             (iget(358)>0).OR.(iget(359)>0).OR.  &
             (iget(360)>0).OR.(iget(361)>0).OR.  &
             (iget(362)>0).OR.(iget(363)>0).OR.  &
             (iget(364)>0).OR.(iget(365)>0).OR.  &
             (iget(366)>0).OR.(iget(367)>0).OR.  &
             (iget(368)>0).OR.(iget(369)>0).OR.  &
             (iget(370)>0).OR.(iget(371)>0).OR.  &
             (iget(372)>0).OR.(iget(373)>0).OR.  &
             (iget(374)>0).OR.(iget(375)>0)))THEN
              fname = d3dout
              if(me==0)print*,' FNAME FROM D3DOUT=',trim(fname)
          ELSE IF(ipvout(1:4)/=blank .AND.           &
              index(datset(1:kdat),"IPV")>0 .AND.  &
             ((iget(332)>0).OR.(iget(333)>0).OR.  &
             (iget(334)>0).OR.(iget(335)>0).OR.  &
             (iget(351)>0).OR.(iget(352)>0).OR.  &
             (iget(353)>0).OR.(iget(378)>0)))THEN
              fname = ipvout
              if(me==0)print*,' FNAME FROM IPVOUT=',trim(fname)
          ELSE IF(pgbout(1:4)/=blank)THEN
            fname = pgbout
            if(me==0)print*,' FNAME FROM PGBOUT=',trim(fname)
          ELSE
              ndig=max(log10(ihr+0.5)+1.,2.)
!          WRITE(CFORM,'("('.GrbF',I",I1,".",I1,")")') NDIG,NDIG
              WRITE(cform,'("(I",I1,".",I1,")")') ndig,ndig
              WRITE(cfhour,cform) ihr
              fname = datset(1:kdat) //'.GrbF'// cfhour
              if(me==0)print *,' FNAME=',trim(fname)
          END IF
!         IF(MODELNAME=='GFS'.AND.PGBOUT(1:4)/=BLANK)THEN
!          FNAME = PGBOUT
!          PRINT*,' FNAME FROM PGBOUT=',trim(FNAME)
!
         ELSEIF (envar(1:4)==blank.AND.resthr(1:4)==blank) THEN
          IF(ifmin >= 1)THEN
           WRITE(descr2,1011) ihr
           WRITE(descr3,1012) ifmin
           fname = datset(1:kdat) // trim(descr2)  //'.'// descr3(1:2)
          ELSE
           ndig=max(log10(ihr+0.5)+1.,2.)
!          WRITE(CFORM,'("('.GrbF',I",I1,".",I1,")")') NDIG,NDIG
           WRITE(cform,'("(I",I1,".",I1,")")') ndig,ndig
           WRITE(cfhour,cform) ihr
           fname = datset(1:kdat) //'.GrbF'// cfhour
           if(me==0)print *,' FNAME=',trim(fname)
!
!          IF(IHR<100)THEN
!           WRITE(DESCR2,1011) IHR
!          ELSE
!           WRITE(DESCR2,1013) IHR
!          END IF
 1011      FORMAT('.GrbF',i2.2)
!1013      FORMAT('.GrbF',I3.3)
!          FNAME = DATSET(1:KDAT) // DESCR2
          END IF
!
         ELSEIF(envar(1:4)==blank.AND.resthr(1:4)/=blank) THEN
          IF(ifmin >= 1)THEN
           WRITE(descr3,1012) ifmin
           IF (ihr<100) THEN
              WRITE(descr2,1012) ihr
              fname = datset(1:kdat) // descr2(1:2)  //'.'// descr3(1:2) &
                 //'.'// resthr
           ELSE
              WRITE(descr2,1014) ihr
              fname = datset(1:kdat) // descr2(1:3)  //'.'// descr3(1:2) &
                 //'.'// resthr
           ENDIF
          ELSE
           IF (ihr<100) THEN
             WRITE(descr2,1012) ihr
             fname = datset(1:kdat) // descr2(1:2)  //'.'// resthr
           ELSE
             WRITE(descr2,1014) ihr
             fname = datset(1:kdat) // descr2(1:3)  //'.'// resthr
           ENDIF
          end if
         ELSE
          IF(ifmin >= 1)THEN
           WRITE(descr3,1012) ifmin
           IF (ihr<100) THEN
             WRITE(descr2,1012) ihr
             fname = envar(1:kenv) // datset(1:kdat) // descr2(1:2)  &
             //'.'// descr3(1:2) //'.'// resthr
           ELSE
             WRITE(descr2,1014) ihr
             fname = envar(1:kenv) // datset(1:kdat) // descr2(1:3)  &
             //'.'// descr3(1:2) //'.'// resthr
           ENDIF
          ELSE
           IF (ihr<100) THEN
             WRITE(descr2,1012) ihr
             fname = envar(1:kenv) // datset(1:kdat) // descr2(1:2) &
                    //'.'// resthr
 1012        FORMAT(i2.2)
 1014        FORMAT(i3.3)
           ELSE
             WRITE(descr2,1014) ihr
             fname = envar(1:kenv) // datset(1:kdat) // descr2(1:3) &
                    //'.'// resthr
           ENDIF
          end if
         ENDIF
!
      ENDIF
      if(me==0) then
        print*,'FNAME= ',trim(fname)
        print *,'end of get post filename'
      endif
 
      end subroutine get_postfilename