SUBROUTINE READCNTRL(kth,IEOF)
!
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . .
! SUBPROGRAM: READCNTRL READS CONTROL FILE
! PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-20
!
! ABSTRACT:
! THIS ROUTINE READS THE CONTROL FILE SPECIFYING
! DATA FORMAT(S) AND FIELD(S) TO POST. THE
! ORDER OF OPERATIONS IS
! (1) READ HEADER BLOCK OF CONTROL FILE,
! (2) SET FLAGS, CLOSE OPEN UNITS
! (3) READ BODY OF CONTROL FILE (FIELD SPECIFICATIONS)
! .
!
! PROGRAM HISTORY LOG:
! 92-12-20 RUSS TREADON
! 93-06-15 RUSS TREADON - ADD PROJECTION CONTROL CARD
! 98-06-01 BLACK - CONVERSION OF POST FROM 1-D TO 2-D
! 98-07-17 MIKE BALDWIN - REMOVED PACK84
! 01-10-22 H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT
! 02-01-16 MIKE BALDWIN - WRF VERSION
!
! USAGE: CALL READCNTRL(IEOF)
! INPUT ARGUMENT LIST:
! NONE
!
! OUTPUT ARGUMENT LIST:
! IEOF - INTEGER FLAG FOR EOF IN CONTROL FILE.
! IEOF=0 WHEN AN EOF IS READ IN THE
! CONTROL FILE. IEOF=1 OTHERWISE.
!
! OUTPUT FILES:
! NONE
!
! SUBPROGRAMS CALLED:
! UTILITIES:
!
! LIBRARY:
! COMMON - RQSTFLD
! CTLBLK
!
! ATTRIBUTES:
! LANGUAGE: FORTRAN
! MACHINE : CRAY C-90
!$$$
!
!
! INCLUDE ETA GRID DIMENSIONS. SET/DERIVE PARAMETERS.
!
use lookup_mod,only: ITB,JTB,ITBQ,JTBQ
use ctlblk_mod, only: me, ifhr, ihrst, sdat, imdlty, im, jm
use rqstfld_mod, only: mxfld, iget, kgtype, datset, ritehd, &
field, dec, lvls, mxlvl, avbl, ident, nfld
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
real,PARAMETER :: DTR=1.745329E-2,RTD=1./DTR
!
! DECLARE VARIABLES.
!
LOGICAL NORTH
CHARACTER*2 CHAR2
CHARACTER*4 CHAR4
CHARACTER*80 LINE
REAL EGRID1(IM,JM), EGRID2(IM,JM)
!jw
integer, intent(in) :: KTH
integer, intent(inout) :: IEOF
integer LCNTRL,LUNOUT,ISUM,L,IFLD,IAVBL
!
!******************************************************************************
! START READCNTRL HERE.
!
LCNTRL=14
LUNOUT=60
IF(ME.EQ.0)THEN
WRITE(6,*)'READCNTRL: POSTING FCST HR ',IFHR,' FROM ', &
IHRST,'UTC ',SDAT(1),'-',SDAT(2),'-',SDAT(3),' RUN'
ENDIF
!
! INITIALIZE VARIABLES.
! IEOF IS THE END OF FILE FLAG FOR THE CONTROL FILE.
! ARRAY IGET IS THE "GET FIELD" FLAG ARRAY.
!
IEOF=0
DO 100 IFLD=1,MXFLD
IGET(IFLD)=-1
100 CONTINUE
!
if(me.eq.0)print*,'start reading control file'
!
READ(LCNTRL,1000,ERR=990,END=999) KGTYPE
READ(LCNTRL,1000,ERR=990,END=999) IMDLTY
READ(LCNTRL,1030,ERR=990,END=999) DATSET
1000 FORMAT(T28,I5)
1030 FORMAT(T28,A6)
!
! SET FLAG TO OPEN NEW OUTPUT FILE
!
RITEHD = .TRUE.
!
! ECHO HEADER INFO TO 6.
!
IF(ME.EQ.0)THEN
WRITE(6,*)'READCNTRL: HEADER INFORMATION'
WRITE(6,*)' KGTYPE : ',KGTYPE
WRITE(6,*)' IMDLTY : ',IMDLTY
WRITE(6,*)' DATSET : ',DATSET
WRITE(6,*)' RITEHD : ',RITEHD
ENDIF
!
! NOW READ WHICH FIELDS ON
! WHICH LEVELS TO INTERPOLATE TO THE OUTPUT GRID. THE
! CHARACTER STRING "DONE" MARKS THE END OF THE OUTPUT
! FIELD SPECIFICATIONS.
!
IFLD = 0
10 CONTINUE
READ(LCNTRL,1060,ERR=996) LINE
IF (INDEX(LINE,'DONE').NE.0) GOTO 40
IF (INDEX(LINE,'SCAL=').EQ.0) GOTO 10
IFLD = IFLD+1
FIELD(IFLD) = LINE(3:22)
READ(LINE,1061) DEC(IFLD)
READ(LCNTRL,1090,ERR=996) (LVLS(L,IFLD),L=1,MXLVL)
1060 FORMAT(A80)
1061 FORMAT(30X,F4.1)
1070 FORMAT(A4)
1080 FORMAT(A2)
1090 FORMAT(T5,14(5I1,1X))
!
! SEE IF WE WANT THIS FIELD. THE SUM OF THE LEVELS
! INDICATORS MUST BE GREATER THAN ZERO IF WE WANT
! THIS FIELD.
!
ISUM = 0
DO 15 L = 1,MXLVL
ISUM = ISUM + LVLS(L,IFLD)
15 CONTINUE
IF (ISUM.LT.1) THEN
IFLD = IFLD - 1
GOTO 10
ENDIF
!
! SEE IF REQUESTED FIELD IS AVAILABLE. IF NOT,
! WRITE MESSAGE TO 6 AND DECREMENT FIELD
! COUNTER BY ONE. THEN READ NEXT REQUESTED FIELD.
!
DO 20 IAVBL = 1,MXFLD
IF (INDEX(FIELD(IFLD),AVBL(IAVBL)).NE.0)GO TO 30
20 CONTINUE
IF(ME.EQ.0)THEN
WRITE(6,*)'FIELD ',FIELD(IFLD),' NOT AVAILABLE'
ENDIF
IFLD = IFLD-1
GOTO 10
!
! IF FIELD IS AVAILABLE, TURN THE GET SWITCH ON.
!
30 CONTINUE
IGET(IAVBL) = IFLD
IDENT(IFLD) = IAVBL
GOTO 10
!
! ALL DONE READING REQUESTED FIELDS FOR CURRENT OUTPUT GRID.
! SET NFLD TO TOTAL NUMBER OF REQUESTED OUTPUT FIELDS THAT
! ARE AVAILABLE.
!
40 CONTINUE
NFLD = IFLD
! skip creating ipv files if kth=0 and no isobaric fields are requested in ctl file
if(kth==0 .and. iget(013)<=0)go to 999
!
! ECHO OUTPUT FIELDS/LEVELS TO 6.
!
IF(ME.EQ.0)THEN
WRITE(6,*)'BELOW ARE FIELD/LEVEL/SMOOTHING ', &
'SPECIFICATIONS.,NFLD=',NFLD,'MXLVL=',MXLVL
ENDIF
DO 50 IFLD = 1,NFLD
IF(ME.EQ.0)THEN
WRITE(6,2060) FIELD(IFLD)
WRITE(6,2070) (LVLS(L,IFLD),L=1,MXLVL)
2060 FORMAT('(',A20,')')
2070 FORMAT('L=(',14(5I1,1X),')')
ENDIF
50 CONTINUE
!
! WE HAVE AN OUTPUT GRID AND THE FIELDS TO GENERATE ON IT.
! SKIP OVER THE FOLLOWING EOF MESSAGE TO EXIT THIS ROUTINE.
!
GOTO 60
!
! WE REACH THIS BLOCK ONLY IF THERE IS AN ERROR WHILE READING
! IN THE CONTROL FILE. PRINT AN ERROR MESSAGE TO STANDARD
! OUT AND CARRY ON.
!
990 CONTINUE
IF(ME.EQ.0)THEN
WRITE(6,*)' READCNTRL: ERROR READING CNTRL HEADER INFO'
WRITE(6,*)' BELOW IS CNTRL GRID INFO'
WRITE(6,*)' KGTYPE,DATSET: ',KGTYPE,' ',DATSET
ENDIF
GOTO 999
996 CONTINUE
IF(ME.EQ.0)THEN
WRITE(6,*)' READCNTRL: ERROR READING CNTRL FLD/LVL INFO'
ENDIF
!
! WE REACH THIS BLOCK ONLY WHEN AN EOF HAS BEEN READ FROM
! THE CONTROL FILE. THAT MEANS WE'VE PROCESSED ALL GRIDS
! AND ALL FIELDS. WE'RE DONE. SET THE EOF FLAG TO ANY
! NONZERO INTEGER, SAY ONE. CLOSE THE UNIT CONNECTED TO
! THE LAST OUTPUT FILE AND EXIT THE ROUTINE.
!
999 CONTINUE
IEOF=1
CLOSE(LUNOUT)
IF(ME.EQ.0)THEN
WRITE(6,*)' READCNTRL: ALL GRIDS PROCESSED. ', &
'CLOSED ',LUNOUT
ENDIF
!
! END OF ROUTINE.
!
60 CONTINUE
RETURN
END