1 subroutine get_postfilename(fname)
9 use ctlblk_mod
, only : ifhr, me, modelname, ifmin
10 use rqstfld_mod
, only : ritehd, datset, iget
14 character(*),
intent(inout) :: fname
17 integer ihr,kdat,kenv,kthr,ndig
18 CHARACTER*4 resthr,blank
19 CHARACTER*10 descr2,descr3
20 character cfhour*40,cform*40
22 CHARACTER*255 pgbout,ipvout,d3dout
40 CALL getenv(
'COMSP',envar)
41 CALL getenv(
'tmmark',resthr)
42 CALL getenv(
'PGBOUT',pgbout)
43 CALL getenv(
'IPVOUT',ipvout)
44 CALL getenv(
'D3DOUT',d3dout)
45 kdat = index(datset,
' ') -1
46 IF (kdat<=0) kdat = len(datset)
47 kenv = index(envar,
' ') -1
48 IF (kenv<=0) kenv = len(envar)
49 kthr = index(resthr,
' ') -1
50 IF (kthr<=0) kthr = len(resthr)
51 if(me==0) print *,
'PGBOUT=',trim(pgbout)
53 if(me==0)print *,
'in get postfilename, ritehd=',ritehd,
'ifhr=',ifhr,
'modelname=',modelname, &
54 'ENVAR(1:4)=',envar(1:4),
'RESTHR(1:4)=',resthr(1:4),
'ifmin=',ifmin,
'DATSET(1:KDAT)=', &
58 IF(modelname==
'GFS')
THEN
59 IF(d3dout(1:4)/=blank .AND. &
60 ((iget(354)>0).OR.(iget(355)>0).OR. &
61 (iget(356)>0).OR.(iget(357)>0).OR. &
62 (iget(358)>0).OR.(iget(359)>0).OR. &
63 (iget(360)>0).OR.(iget(361)>0).OR. &
64 (iget(362)>0).OR.(iget(363)>0).OR. &
65 (iget(364)>0).OR.(iget(365)>0).OR. &
66 (iget(366)>0).OR.(iget(367)>0).OR. &
67 (iget(368)>0).OR.(iget(369)>0).OR. &
68 (iget(370)>0).OR.(iget(371)>0).OR. &
69 (iget(372)>0).OR.(iget(373)>0).OR. &
70 (iget(374)>0).OR.(iget(375)>0)))
THEN
72 if(me==0)print*,
' FNAME FROM D3DOUT=',trim(fname)
73 ELSE IF(ipvout(1:4)/=blank .AND. &
74 index(datset(1:kdat),
"IPV")>0 .AND. &
75 ((iget(332)>0).OR.(iget(333)>0).OR. &
76 (iget(334)>0).OR.(iget(335)>0).OR. &
77 (iget(351)>0).OR.(iget(352)>0).OR. &
78 (iget(353)>0).OR.(iget(378)>0)))
THEN
80 if(me==0)print*,
' FNAME FROM IPVOUT=',trim(fname)
81 ELSE IF(pgbout(1:4)/=blank)
THEN
83 if(me==0)print*,
' FNAME FROM PGBOUT=',trim(fname)
85 ndig=max(log10(ihr+0.5)+1.,2.)
87 WRITE(cform,
'("(I",I1,".",I1,")")') ndig,ndig
88 WRITE(cfhour,cform) ihr
89 fname = datset(1:kdat) //
'.GrbF'// cfhour
90 if(me==0)print *,
' FNAME=',trim(fname)
96 ELSEIF (envar(1:4)==blank.AND.resthr(1:4)==blank)
THEN
98 WRITE(descr2,1011) ihr
99 WRITE(descr3,1012) ifmin
100 fname = datset(1:kdat) // trim(descr2) //
'.'// descr3(1:2)
102 ndig=max(log10(ihr+0.5)+1.,2.)
104 WRITE(cform,
'("(I",I1,".",I1,")")') ndig,ndig
105 WRITE(cfhour,cform) ihr
106 fname = datset(1:kdat) //
'.GrbF'// cfhour
107 if(me==0)print *,
' FNAME=',trim(fname)
114 1011
FORMAT(
'.GrbF',i2.2)
119 ELSEIF(envar(1:4)==blank.AND.resthr(1:4)/=blank)
THEN
121 WRITE(descr3,1012) ifmin
123 WRITE(descr2,1012) ihr
124 fname = datset(1:kdat) // descr2(1:2) //
'.'// descr3(1:2) &
127 WRITE(descr2,1014) ihr
128 fname = datset(1:kdat) // descr2(1:3) //
'.'// descr3(1:2) &
133 WRITE(descr2,1012) ihr
134 fname = datset(1:kdat) // descr2(1:2) //
'.'// resthr
136 WRITE(descr2,1014) ihr
137 fname = datset(1:kdat) // descr2(1:3) //
'.'// resthr
142 WRITE(descr3,1012) ifmin
144 WRITE(descr2,1012) ihr
145 fname = envar(1:kenv) // datset(1:kdat) // descr2(1:2) &
146 //
'.'// descr3(1:2) //
'.'// resthr
148 WRITE(descr2,1014) ihr
149 fname = envar(1:kenv) // datset(1:kdat) // descr2(1:3) &
150 //
'.'// descr3(1:2) //
'.'// resthr
154 WRITE(descr2,1012) ihr
155 fname = envar(1:kenv) // datset(1:kdat) // descr2(1:2) &
160 WRITE(descr2,1014) ihr
161 fname = envar(1:kenv) // datset(1:kdat) // descr2(1:3) &
169 print*,
'FNAME= ',trim(fname)
170 print *,
'end of get post filename'
173 end subroutine get_postfilename