SUBROUTINE WRVTGD(KFILDO,KFILVT,KFILGD,ID,KDATE,CCALL,DATA, 1 NSTA,ALAT,ALON,ORIENT,MESHL,XLAT,NX,NY,ND7, 2 ISCALD,ISCALE,ICTRL,L3264B,L3264W,ISTOP, 3 IPLAIN,PLAIN,IERV,IERG,NPROJ) C C APRIL 2003 CHARBA TDL MOS-2000 C C PURPOSE C TO WRITE A VECTOR OR A GRIDDED OUTPUT FILE (OR BOTH) IN C TDLPACK SEQUENTIAL FORMAT. PRIOR TO THE WRITING OF THESE C DATA VARIOUS PREPARATION FUNCTIONS, SUCH AS ID FORMULATIONS, C SCALING, AND PACKING OF THE DATA RECORDS IS PERFORMED. C THE DATA RECORDS WRITTEN ARE UNIQUE IN THAT THEY APPLY C TO GRIDPOINTS. THIS FEATURE ALLOWS THE DATA TO BE WRITTEN C IN BOTH VECTOR AND GRIDDED FILE FORMAT. TO WRITE THE VECTOR C FILE, PACKV IS USED. TO WRITE THE GRID FILE, A MODIFIED C VERSION OF PAWOTG, CALLED PWOTGM, IS USED. THE ARGUMENT C LIST FOR PWOTGM IS IDENTICAL TO THAT FOR PAWOTG, EXCEPT THAT C XMESHL REPLACES MESH IN THE LATTER. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILVT - UNIT NUMBER FOR VECTOR TDLPACK OUTPUT FILE. C (OUTPUT) C KFILGD - UNIT NUMBER FOR GRIDDED TDLPACK OUTPUT FILE. C (OUTPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILVT = UNIT NUMBER FOR VECTOR TDLPACK OUTPUT FILE. C (INPUT) C KFILGD = UNIT NUMBER FOR GRIDDED TDLPACK OUTPUT FILE. C (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP(16) C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWOTG. (INTERNAL) C ID1 = FIRST WORD OF MOS2000 VARIABLE ID. (INPUT) C ID(J) = THE INTEGER VARIABLE ID (J=1,4). (INTERNAL) C ITAUH = PROJECTION IN HOURS. (INTERNAL) C ITAUM = PROJECTION IN MINUTES. (INTERNAL) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID CORRESPONDING TO ID( ) (J=1,15). C (INTERNAL) C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY C 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK C IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C JP(J) = JP( ) INDICATES WHETHER (>0) OR NOT (=0) THE C VARIABLE WILL BE OUTPUT FOR VIEWING. C J=1--NOT USED, C J=2--NOT USED, AND C J=3--INTERPOLATED (VECTOR) VALUES. C THIS ALLOWS INDIVIDUAL VARIABLE CONTROL ON C THE PRINT PARAMETER IPX. (INTERNAL) C ISCALD = THE DECIMAL SCALING CONSTANT TO USE WHEN C PACKING THE DATA. (INPUT) C ISCALE = THE BINARY SCALING CONSTANT TO USE WHEN C PACKING THE DATA. THIS IS ALWAYS 0. (INPUT) C ICTRL = SPECIFIES TO WHAT FILE(S) (IF ANY) A VARIABLE C WILL BE OUTPUT. (INPUT) C = 0, VARIABLE IS NOT OUTPUT (THIS SHOULD NOT C OCCUR). C = 1, VARIABLE IS OUTPUT TO A VECTOR FILE ONLY. C = 2, VARIABLE IS OUTPUT TO A GRID FILE ONLY. C = 3, VARIABLE IS OUTPUT TO BOTH A VECTOR AND A C GRID FILE. C IPLAIN(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN C LANGUAGE DESCRIPTION OF VARIABLE (EQUIVALENCED C TO PLAIN IN DRU523). (INPUT) C NOTE: L=1,2 ON A 32-BIT/WORD MACHINE, AND C L=1,1 ON 64-BIT/WORD MACHINE. C PLAIN = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLE C EQUIVALENCED TO IPLAIN( , )IN DRU523 C (CHARACTER*32). (INTERNAL) C KDATE = THE DATE/TIME FOR WHICH VARIABLES ARE BEING C PROCESSED. (INPUT) C KYR = YEAR, 4 DIGITS. (INTERNAL) C KMO = MONTH. (INTERNAL) C KDA = DAY OF MONTH. (INTERNAL) C KHR = HOUR, 2 DIGITS. (INTERNAL) C CCALL(K) = 8 STATION CALL LETTERS (K=1,NSTA). USED FOR C PRINTOUT ONLY. (CHARACTER*8) (INPUT) C DATA(K) = DATA FOR WRITING (K=1,NSTA). (INPUT) C JPACK(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C IA(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C IC(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C NSTA = DIMENSION OF CCALL( ), DATA( ), IA( ), IC( ), C AND JPACK( ). NSTA MUST BE GE NX*NY. (INPUT) C MODNO = MODEL NUMBER. (INTERNAL) C NSEQ = SEQUENCE NUMBER. (INTERNAL) C MINPK = VALUES ARE PACKED IN GROUPS OF MINIMUM SIZE C MINPK. ONLY WHEN THE NUMBER OF BITS TO HANDLE C A GROUP CHANGES WILL A NEW GROUP BE FORMED. C (INTERNAL) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,29). C (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C (INTERNAL) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C (INPUT) C XMISSP = PRIMARY MISSING VALUE. (INTERNAL) C XMISSS = SECONDARY MISSING VALUE. (INTERNAL) C IPX = INDICATES WHETHER (>1) OR NOT (=0) DATA C VALUES WILL BE WRITTEN TO UNIT IPX FOR VIEWING. C (INTERNAL) C NWRDSV = THE NUMBER OF PACKED WORDS IN JPACK( ) FOR C VECTOR FILE. (INTERNAL) C NWRDSG = THE NUMBER OF PACKED WORDS IN JPACK( ) FOR C GRID FILE. (INTERNAL) C NTOTBV = THE TOTAL NUMBER OF BYTES IN PACKED DATA RECORDS C WRITTEN FOR VECTOR FILE. (INTERNAL) C NTOTBG = THE TOTAL NUMBER OF BYTES IN PACKED DATA RECORDS C WRITTEN FOR GRID FILE. (INTERNAL) C NTOTRV = THE TOTAL NUMBER OF PACKED RECORDS WRITTEN TO C VECTOR FILE. (INTERNAL) C NTOTRG = THE TOTAL NUMBER OF PACKED RECORDS WRITTEN TO C GRID FILE. (INTERNAL) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) C ISTOP = INCREMENTED BY ONE EACH TIME AN ERROR IS C ENCOUNTERED. (INPUT-OUTPUT) C IERV = STATUS RETURN FROM PACKV. C 0 = GOOD RETURN. C 16 = ND7 NOT LARGE ENOUGH. SET ND7 GE 54. C SEE ROUTINES PACK1D, UNPKBG, AND WRITEP, WHICH C ARE CALLED BY PACKV, FOR OTHER VALUES. C (INTERNAL) C IERG = STATUS RETURN FROM PWOTGM. C 0 = GOOD VALUE. C 51 = ND5 LT NX*NY. C OTHER VALUES COME FROM CALLED SUBROUTINES AND C SHOULD BE TREATED AS FATAL IN THIS ROUTINE. C (INTERNAL) C IOCTTG = THE PACKED GRID RECORD SIZE IN OCTETS (BYTES). C (INTERNAL) C NPROJ = MAP PROJECTION NUMBER. (INPUT) C ALAT = LATITUDE OF LL CORNER OF GRID IN DEG. (INPUT) C ALON = LONGITUDE OF LL CORNER OF GRID IN DEG. (INPUT) C ORIENT = LONGITUDE OF GRID ORIENTATION IN DEG. (INPUT) C XMESHL = GRID MESHLENGTH TRUE AT XLAT (METERS). (INPUT) C XLAT = NORTH LATITUDE IN DEGREES AT WHICH XMESHL C APPLIES. (INPUT) C NX = X EXTENT OF THE GRID. (INPUT) C NY = Y EXTENT OF THE GRID. (INPUT) C LX = THE NUMBER OF GROUPS (THE NUMBER OF 2ND ORDER C MINIMA). WHILE NEEDED ONLY IN SUBROUTINE PACK, C IT IS OUTPUT IN THE ARGUMENT LIST OF PAWOTG IN C CASE THE USER WANTS TO KNOW IT. (OUTPUT) C NCHAR = THE NUMBER OF CHARACTERS OF PLAIN LANGUAGE C IN PLAIN TO PACK WITH THE DATA. (INPUT) C IFIRST = CONTROLS WRITING OF GRIDPOINT "CALL LETTERS" C ON FIRST ENTRY TO WRVTGD ("PACKV SECTION") TO C KFILVT. (INTERNAL) C NBYTES(L) = USED (IN WRITING OF THE CALL LETTERS RECORD OF C THE VECTOR FILE) AS EITHER TWO WORDS FOR A C 32-BIT MACHINE OR ONE WORD FOR A 64-BIT MACHINE C (L=1,2). (INTERNAL) C C NONSYSTEM SUBROUTINES CALLED C PRSID,PACKV,PWOTGM C C*********************************************************************** C DIMENSION DATA(NSTA) C C THE ARRAYS BELOW ARE AUTOMATIC ARRAYS DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7),IA(NSTA),IC(NSTA), 1 JPACK(NSTA) C DIMENSION ID(4),JP(3),IDPARS(15),NBYTES(2) DIMENSION IPLAIN(L3264W,4) CHARACTER*8 CCALL(NSTA) CHARACTER*32 PLAIN C DATA JP/3*0/,IP16/0/,IPX/0/,NBYTES/0,0/, 1 MINPK/14/,NCHAR/32/,ITAUH/0/,ITAUM/0/,MODNO/0/,NSEQ/0/, 2 XMISSP/9999./,XMISSS/9997./,IFIRST/0/, 3 NTOTBV,NTOTBG,NTOTRV,NTOTRG/4*0/ C SAVE IFIRST C C*********************************************************************** C KYR=KDATE/1000000 KMO=MOD(KDATE,1000000)/10000 KDA=MOD(KDATE,10000)/100 KHR=MOD(KDATE,100) C C PRINT OUT IDS OF VARIABLE BEING PROCESSED. C c WRITE(KFILDO,245) KDATE,(ID(JJ),JJ=1,4),PLAIN,ISCALD,ISCALE,NPROJ c245 FORMAT('IN WRVTGD, DATE AND VARIABLE BEING PROCESSED: ',5I12.9,/, c 1 ' PLAIN LANGUAGE: ',A32,/, c 2 ' ISCALD =',I3,' ISCALE =',I3,' MAP PROJ =',I3) C C SET ERROR RETURN VARIABLES AND ID(1). C IERV=0 IERG=0 c WRITE(KFILDO,500) KFILDO,KFILVT,KFILGD,ICTRL c500 FORMAT(/,"KFILDO:",I2," KFILVT: ",I2," KFILGD: ",I2," ICTRL:",I2) c WRITE(KFILDO,501) KDATE,ID c501 FORMAT("DATE AND VARIABLE ID: ",I10,4I11.9) c WRITE(KFILDO,502) CCALL(1),DATA(1) c502 FORMAT("1ST ELEMENT OF CCALL( ) AND DATA( ) :",A8,2X,F9.4) c WRITE(KFILDO,503) NX,NY,NSTA c503 FORMAT("GRID DIMENSIONS: NX=",I4," NY=",I4," NSTA=",I8) c WRITE(KFILDO,504) ALAT,ALON,ORIENT,XMESHL,XLAT c504 FORMAT("GRID SPECS: ",5F10.4) c WRITE(KFILDO,505) ISCALD,ISCALE c505 FORMAT("ISCALD,ISCALE: ",2I3,/) C c WRITE(KFILDO,202) (CCALL(II),DATA(II),II=1,NSTA,5000) c202 FORMAT(//,'CCALL( ), DATA( ):',/,5(A8,1X,F10.4,1X)) C WRITE(KFILDO,202)(II,DATA(II),II=1,NSTA,1000) C202 FORMAT(//,' DATA:',/,5(I8,F10.4,1X)) C IF(ICTRL.EQ.1.OR.ICTRL.EQ.3) THEN C C ON FIRST ENTRY WRITE GRIDPOINT "CALL LETTERS" TO KFILVT. C IF(IFIRST.EQ.0) THEN IFIRST=1 C WRITE(KFILDO,509) (CCALL(J),J=1,NSTA,1000) C509 FORMAT(16(1X,A8)) C NBYTES(L3264W)=NSTA*8 C WRITE(KFILDO,510) (NBYTES(J),J=1,L3264W) c510 FORMAT("NBYTES: ",2I10) WRITE(KFILVT,IOSTAT=IOS,ERR=260) (NBYTES(J),J=1,L3264W), 1 (CCALL(K),K=1,NSTA) C WRITE(KFILDO,255) C255 FORMAT(' WROTE UNPACKED STATION LIST RECORD ON FIRST CALL TO ' C 1 ,'WRVTGD') ENDIF GO TO 300 C 260 WRITE(KFILDO,270) 270 FORMAT('**** ERROR WRITING CALL LETTERS RECORD FOR VECTOR FILE ' 1 ,'IN WRVTGD ...CONTINUE PROCESSING.') C C FETCH THE PARSED IDS. C 300 CALL PRSID1(KFILDO,ID,IDPARS) C C OUTPUT DATA( ) TO VECTOR FILE. C CALL PACKV(KFILDO,KFILVT,ID,IDPARS, 1 JP,ISCALD,ISCALE, 2 IPLAIN,PLAIN,KDATE,KYR,KMO,KDA,KHR, 3 CCALL,IA,DATA,NSTA,NSTA,JPACK,NSTA,MINPK, 4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS, 5 IPX,NWRDSV,NTOTBV,NTOTRV, 6 L3264B,L3264W,ISTOP,IERV) C C IF(IERV.EQ.0) WRITE(KFILDO,320) KDATE,NTOTRV,NWRDSV,NTOTBV C320 FORMAT(' FOR KDATE = ',I10,' WROTE PACKED VECTOR RECORD.', C 1 ' NTOTRV,NWRDSV,NTOTBV = ',4I10) C ENDIF C IF(ICTRL.EQ.2.OR.ICTRL.EQ.3) THEN C C OUTPUT DATA( ) TO GRID FILE. C CALL PAWOTG(KFILDO,KFILGD,IP16,KDATE, 1 ID,ITAUH,ITAUM,MODNO,NSEQ,ISCALD, 2 NPROJ,ALAT,ALON,ORIENT,MESHL,XLAT,NX,NY, 3 DATA,IA,IC,JPACK,NSTA,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLAIN,PLAIN,NCHAR, 6 XMISSP,XMISSS,LX,IOCTTG, 7 NTOTBG,NTOTRG,L3264B,L3264W,IERG) C NWRDSG=IOCTTG*8/L3264B C C IF(IERG.EQ.0) WRITE(KFILDO,340) KDATE,NTOTRG,NWRDSG,NTOTBG C340 FORMAT(' FOR KDATE = ',I10,' WROTE PACKED GRID RECORD.', C 1 ' NTOTRG,NWRDSG,NTOTBG = ',4I10) C ENDIF C C WRITE(KFILDO,350) IERV,IERG c350 FORMAT("IERV: ",I3," IERG: ",I3) RETURN END