SUBROUTINE MSGINI(LUN) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: MSGINI C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06 C C ABSTRACT: THIS SUBROUTINE INITIALIZES, WITHIN THE INTERNAL ARRAYS, A C NEW BUFR MESSAGE FOR OUTPUT. ARRAYS ARE FILLED IN COMMON BLOCKS C /MSGPTR/, /MSGCWD/ AND /BITBUF/. C C PROGRAM HISTORY LOG: C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR C 1996-12-11 J. WOOLLEN -- MODIFIED TO ALLOW INCLUSION OF MINUTES IN C WRITING THE MESSAGE DATE INTO A BUFR C MESSAGE C 1997-07-29 J. WOOLLEN -- MODIFIED TO UPDATE THE CURRENT BUFR VERSION C WRITTEN IN SECTION 0 FROM 2 TO 3 C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB C ROUTINE "BORT"; MODIFIED TO MAKE Y2K C COMPLIANT C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE C OPENED AT ONE TIME INCREASED FROM 10 TO 32 C (NECESSARY IN ORDER TO PROCESS MULTIPLE C BUFR FILES UNDER THE MPI) C 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM C 10,000 TO 20,000 BYTES C 2002-05-14 J. WOOLLEN -- REMOVED ENTRY POINT MINIMG (IT BECAME A C SEPARATE ROUTINE IN THE BUFRLIB TO C INCREASE PORTABILITY TO OTHER PLATFORMS) C 2003-11-04 J. ATOR -- ADDED DOCUMENTATION C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE C INTERDEPENDENCIES C 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES) C INCREASED FROM 15000 TO 16000 (WAS IN C VERIFICATION VERSION); UNIFIED/PORTABLE FOR C WRF; ADDED HISTORY DOCUMENTATION; OUTPUTS C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE C TERMINATES ABNORMALLY C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM C 20,000 TO 50,000 BYTES C 2005-11-29 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 12 C 2009-05-07 J. ATOR -- CHANGED DEFAULT MASTER TABLE VERSION TO 13 C 2009-08-11 J. WOOLLEN -- ADD COMMON UFBCPL TO INITIALIZE LUNCPY C C USAGE: CALL MSGINI (LUN) C INPUT ARGUMENT LIST: C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS C C REMARKS: C THIS ROUTINE CALLS: BORT NEMTAB NEMTBA PKB C PKC C THIS ROUTINE IS CALLED BY: CPYUPD MSGUPD OPENMB OPENMG C Normally not called by any application C programs. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: PORTABLE TO ALL PLATFORMS C C$$$ INCLUDE 'bufrlib.prm' COMMON /PADESC/ IBCT,IPD1,IPD2,IPD3,IPD4 COMMON /MSGPTR/ NBY0,NBY1,NBY2,NBY3,NBY4,NBY5 COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES), . INODE(NFILES),IDATE(NFILES) COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES), . MBAY(MXMSGLD4,NFILES) COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL), . JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL), . IBT(MAXJL),IRF(MAXJL),ISC(MAXJL), . ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL), . ISEQ(MAXJL,2),JSEQ(MAXJL) COMMON /UFBCPL/ LUNCPY(NFILES) CHARACTER*128 BORT_STR CHARACTER*10 TAG CHARACTER*8 SUBTAG CHARACTER*4 BUFR,SEVN CHARACTER*3 TYP CHARACTER*1 TAB DATA BUFR/'BUFR'/ DATA SEVN/'7777'/ C----------------------------------------------------------------------- C----------------------------------------------------------------------- C GET THE MESSAGE TAG AND TYPE, AND BREAK UP THE DATE C --------------------------------------------------- SUBTAG = TAG(INODE(LUN)) c .... Given SUBSET, NEMTBA returns MTYP,MSBT,INOD CALL NEMTBA(LUN,SUBTAG,MTYP,MSBT,INOD) IF(INODE(LUN).NE.INOD) GOTO 900 CALL NEMTAB(LUN,SUBTAG,ISUB,TAB,IRET) IF(IRET.EQ.0) GOTO 901 C DATE CAN BE YYMMDDHH OR YYYYMMDDHH C ---------------------------------- MCEN = MOD(IDATE(LUN)/10**8,100)+1 MEAR = MOD(IDATE(LUN)/10**6,100) MMON = MOD(IDATE(LUN)/10**4,100) MDAY = MOD(IDATE(LUN)/10**2,100) MOUR = MOD(IDATE(LUN) ,100) MMIN = 0 c .... DK: Can this happen?? (investigate) IF(MCEN.EQ.1) GOTO 902 IF(MEAR.EQ.0) MCEN = MCEN-1 IF(MEAR.EQ.0) MEAR = 100 C INITIALIZE THE MESSAGE C ---------------------- MBIT = 0 NBY0 = 8 NBY1 = 18 NBY2 = 0 NBY3 = 20 NBY4 = 4 NBY5 = 4 NBYT = NBY0+NBY1+NBY2+NBY3+NBY4+NBY5 C SECTION 0 C --------- CALL PKC(BUFR , 4 , MBAY(1,LUN),MBIT) CALL PKB(NBYT , 24 , MBAY(1,LUN),MBIT) CALL PKB( 3 , 8 , MBAY(1,LUN),MBIT) C SECTION 1 C --------- CALL PKB(NBY1 , 24 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 3 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 7 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) CALL PKB(MTYP , 8 , MBAY(1,LUN),MBIT) CALL PKB(MSBT , 8 , MBAY(1,LUN),MBIT) CALL PKB( 13 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) CALL PKB(MEAR , 8 , MBAY(1,LUN),MBIT) CALL PKB(MMON , 8 , MBAY(1,LUN),MBIT) CALL PKB(MDAY , 8 , MBAY(1,LUN),MBIT) CALL PKB(MOUR , 8 , MBAY(1,LUN),MBIT) CALL PKB(MMIN , 8 , MBAY(1,LUN),MBIT) CALL PKB(MCEN , 8 , MBAY(1,LUN),MBIT) C SECTION 3 C --------- CALL PKB(NBY3 , 24 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 16 , MBAY(1,LUN),MBIT) CALL PKB(2**7 , 8 , MBAY(1,LUN),MBIT) CALL PKB(IBCT , 16 , MBAY(1,LUN),MBIT) CALL PKB(ISUB , 16 , MBAY(1,LUN),MBIT) CALL PKB(IPD1 , 16 , MBAY(1,LUN),MBIT) CALL PKB(IPD2 , 16 , MBAY(1,LUN),MBIT) CALL PKB(IPD3 , 16 , MBAY(1,LUN),MBIT) CALL PKB(IPD4 , 16 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) C SECTION 4 C --------- CALL PKB(NBY4 , 24 , MBAY(1,LUN),MBIT) CALL PKB( 0 , 8 , MBAY(1,LUN),MBIT) C SECTION 5 C --------- CALL PKC(SEVN , 4 , MBAY(1,LUN),MBIT) C DOUBLE CHECK INITIAL MESSAGE LENGTH C ----------------------------------- IF(MOD(MBIT,8).NE.0) GOTO 903 IF(MBIT/8.NE.NBYT ) GOTO 904 NMSG(LUN) = NMSG(LUN)+1 NSUB(LUN) = 0 MBYT(LUN) = NBYT LUNCPY(LUN)=0 C EXITS C ----- RETURN 900 WRITE(BORT_STR,'("BUFRLIB: MSGINI - MISMATCH BETWEEN INODE (=", & I7,") & POSITIONAL INDEX, INOD (",I7,") OF SUBTAG (",A,") IN & DICTIONARY")') INODE(LUN),INOD,SUBTAG CALL BORT(BORT_STR) 901 WRITE(BORT_STR,'("BUFRLIB: MSGINI - TABLE A MESSAGE TYPE & MNEMONIC ",A," NOT FOUND IN INTERNAL TABLE D ARRAYS")') SUBTAG CALL BORT(BORT_STR) 902 CALL BORT & ('BUFRLIB: MSGINI - BUFR MESSAGE DATE (IDATE) is 0000000000') 903 CALL BORT('BUFRLIB: MSGINI - INITIALIZED MESSAGE DOES NOT END & ON A BYTE BOUNDARY') 904 WRITE(BORT_STR,'("BUFRLIB: MSGINI - NUMBER OF BYTES STORED FOR & INITIALIZED MESSAGE (",I6,") IS NOT THE SAME AS FIRST & CALCULATED, NBYT (",I6)') MBIT/8,NBYT CALL BORT(BORT_STR) END