SUBROUTINE CCONSN(KFILDO,KFILOG,KFILRA,RACESS,NUMRA, 1 IP16,IP22,FD4,ND2X3, 2 P,NX,NY,MESH,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE,PLAINT,IPLANT, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT,IOPTB, 5 NXE,NYE,MESHE,EMESH,MESHL, 6 IS0,IS1,IS2,IS4,ND7, 7 JTOTBY,JTOTRC, 9 L3264B,L3264W,MINPK,ISTOP,IER) C C FEBRUARY 2010 WAGNER MDL MOS-2000 C ADAPTED FROM CAKSNO C C PURPOSE C TO ACCESS THE MOS-2000 EXTERNAL RANDOM ACCESS FILE SYSTEM C AND RETRIEVE THE CONUS SNOW MASK GRID WITH WHICH C TO CLIP THE CONUS SNOW GRIDS. NORMALLY, THIS IS THE NDFD C AREA AND IS HANDLED ELSEWHERE, BUT CONUS SNOW REQUIRES C A SPECIAL CLIPPING GRID. THE STRUCTURE OF U155/U405 DOES C NOT WELL ACCOMMODATE TWO CLIPPING GRIDS, AND THE USUAL NDFD C GRID IS HARDWIRED TO A SPECIFIC STRUCTURE. THE GRID CAN C BE TDLPACKED AND WRITTEN TO UNIT KFILOG AND GRIDPRINTED TO C UNIT IP22 DEPENDING ON IPRTEL KFILOG, AND IP22; HOWEVER, C AT PRESENT, IPRTEL IS SET TO 0 AND THAT IS NOT DONE. C C THE CLIPPING IS CONTROLLED BY 'CCONSN' BEING SPECIFIED C FOR POSTPROCESSING, AND IS NOT LIMITED TO SNOW GRIDS. C FOR INSTANCE, IT MAY BE DESIRED TO POSTPROCESS QPF. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C KFILRA(J)- UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL FILE WITH UNIT C NO. KFILOG. (OUTPUT) C IP22 - UNIT NUMBER FOR GRIDPRINTING. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. WRITING OF GRID IS NOT DONE WHEN C KFILOG = 0 OR IPRTEL = 0. THIS IS FOR C DIAGNOSTIC INFORMATION. C KFILRA(J) = THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). C THE ACCESS ROUTINES ALLOW 6 RANDOM ACCESS C FILES. (INPUT) C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J) C (J=1,6). (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF UNIT NUMBERS IN KFILRA( ) AND C NAMES IN RACESS( ). (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS. (INPUT) C IP22 = UNIT NUMBER FOR GRIDPRINTING. WRITING TO IP22 C OF GRIDPOINT VALUES IS NOT DONE WHEN C IP22 = 0 OR IPRTEL = 0. (INPUT) C FD4(J) = WORK ARRAY TO HOLD CONUS SNOW MASK C (J=1,ND2X3). (INTERNAL) C ND2X3 = SIZE OF FD4( ). (INPUT) C P(IX,JY) = THE GRID TO CLIP (IX=1,NX) (JY=1,NY). C (INPUT/OUTPUT) C NX = X EXTENT OF P( , ). (INPUT) C NY = Y EXTENT OF P( , ). (INPUT) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C MODNO = OUTPUT MODEL NUMBER. (INPUT) C NDATE = THE DATE/TIME OF THE RUN. (INPUT) C PLAINT = PLAIN LANGUAGE DESCRIPTION TO FURNISH TO GTHRES. C EQUIVALENCED TO IPLANT IN DRU155. (INTERNAL) C PLANT(L,J) = 32 CHARACTERS (L=1,L3264W)(J=1,4) OF PLAIN C LANGUAGE DESCRIPTION TO FURNISH TO GTHRES. C EQUIVALENCED TO PLAINT IN DRU155. (INTERNAL) C ALATL = NORTH LATITUDE IN DEGREES OF LOWER LEFT CORNER C POINT OF THE ANALYSIS GRID OF MESH SIZE MESH C AND SIZE SPECIFIED BY NX AND NY. (INPUT) C ALONL = WEST LONGITUDE IN DEGREES OF LOWER LEFT CORNER C POINT OF THE ANALYSIS GRID OF MESH SIZE MESH C AND SIZE SPECIFIED BY NX AND NY. (INPUT) C NPROJ = NUMBER OF THE MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED C IN DEGREES. (INPUT) C NX = THE SIZE OF THE WORKING GRID C IN THE X DIRECTION IN MESH UNITS. (INPUT) C NY = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE Y DIRECTION IN MESH UNITS. (INPUT) C MESH = THE NOMINAL MESH LENGTH OF THE ANALYSIS GRID C SPECIFIED BY NX, NY AT LATITUDE XLAT. C FOR INSTANCE, NOMINAL 80 CORRESPONDS C TO 95.25 KM FOR POLAR STEREOGRAPHIC. FOR C ALL ROUTINES TO WORK, THIS VALUE MUST BE C 1, 3, 5, 10, 20, 40, 80, 160, OR 320. C THE LOWER NUMBERS ARE INTEGERS APPROXIMATING C EVEN FRACTIONS OF BEDIENTS. C IDMESH = THE PROPER VALUE FOR NOMINAL MESHLENGTH IN C THE MOS2000 ID. THIS IS SET BASED ON THE C NOMINAL MESH LENGTH MESH, AND CAN ADAPT TO C 5KM OR 2.5KM GRIDS. C IOPTB(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO THE SUBSETTED AREA AT MESH C LENGTH MESHB. (INPUT) C NXE = X-EXTENT OF HIRES( ). (OUTPUT) C NYE = Y-EXTENT OF HIRES( ). (OUTPUT) C MESHE = NOMINAL MESH LENGTH OF RETURNED CONSTANT GRID C IN HIRES( ). THIS IS THE SAME AS THE INPUT C GRID. (INPUT) C EMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHE. C (INPUT) C MESHL = MESH LENGTH OF DISPOSABLE GRID. (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). 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 C IS4( ). (INPUT) C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. (INPUT/OUTPUT) C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. (INPUT/OUTPUT) 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 MINPK = MINIMUM GROUP SIZE WHEN PACKING THE DATA. C (INPUT) C ISTOP = ISTOP IS INCREMENTED BY 1 EACH TIME AN ERROR C OCCURS. (INPUT/OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = FATAL ERROR C SEE CALLED ROUTINES FOR OTHER VALUES. C ANY NON ZERO VALUE WILL CLOSE OUT THIS C DATE/TIME IN U150. (OUTPUT) C AMESH = ACTUAL MESH LENGTH ASSOCIATED WITH MESH. C (INTERNAL) C IPRTEL = 1 = GRID IS TO BE WRITTEN TO FILE KFILOG C AND GRIDPRINTED FOR THE SUBSETTED AREA; C 0 OTHERWISE. THE FORMER ALSO REQUIRES C KFILOG NE 0 AND THE LATTER REQUIRES IP22 NE 0. C USED BY GTHRES; SET TO 0 FOR ENTRY TO GTHRES. C (INTERNAL) C LD(J) = 4-WORD ID OF CONSTANT GRID TO RETRIEVE. C THIS IS THE CONUS SNOW MASK. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GTHRES, CLIP, TIMPR C CHARACTER*32 PLAINT CHARACTER*60 RACESS(6) C DIMENSION P(ND2X3),FD4(ND2X3) DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION IPLANT(L3264W,4) DIMENSION KFILRA(6) DIMENSION IOPTB(8),LD(4) DIMENSION IDMESH(5) C DATA IDMESH/6,99,5,99,4/ CD CALL TIMPR(KFILDO,KFILDO,'START CCONSN ') CD WRITE(KFILDO,105)MESH,NPROJ,ORIENT,XLAT CD105 FORMAT(/' AT 105 IN CCONSN--MESH,NPROJ,ORIENT,XLAT',2I10,2F10.2) C CALL ACTUAL(KFILDO,MESH,AMESH,TRASH,NPROJ,IER) C MESH IS THE NOMINAL MESH LENGTH OF THE WORKING GRID. MUST C DEFINE THE FLOATING POINT VERSION AMESH FOR GTHRES. C IF(IER.NE.0)THEN ISTOP=ISTOP+1 IER=777 GO TO 700 ENDIF C C TO BUILD THE CORRECT ID FOR THE SNOW CLIPPING C MASK, READ THE VALUE IN IDMESH FOR THE NOMINAL C MESH LENGTH MESH. IF THIS VALUE IS NOT 5, 3, C OR 1, THE NOMINAL MESH LENGTH IS NOT SUPPORTED C YET, AND NO CLIPPING WILL BE DONE. C IF(MESH.GT.5.OR.MESH.LT.1.OR.IDMESH(MESH).EQ.99)THEN WRITE(KFILDO,131)MESH ISTOP=ISTOP+1 GO TO 700 ENDIF C 131 FORMAT(/'****UNABLE TO RECOGNIZE NOMINAL MESH LENGTH ', 1 I2,' IN ROUTINE CCONSN. THE SNOW ANALYSIS', 2 'CANNOT BE CUT. NOT FATAL, BUT COUNTED AS', 3 'AN ERROR. PROCEEDING.') C C THE FOLLOWING WRITES CAN BE USED TO ASSESS IF THE ID C OF THE SNOW CLIPPING MASK IS BEING BUILT CORRECTLY C FOR THE NOMINAL MESH LENGTH. C C WRITE(KFILDO,*)"NOMINAL MESH LENGTH IS ",MESH C WRITE(KFILDO,*)"SO IDMESH IS ",IDMESH(MESH) LD(1)=400306000+(IDMESH(MESH)*10000) C WRITE(KFILDO,*)"CLIPPING MASK ID IS ",LD(1) C C THIS IS THE SNOW MASK FOR CONUS. LD(2)=0 LD(3)=0 LD(4)=0 PLAINT='NDGD CONUS SNOW MASK ' C 32 CHARACTERS OF PLAIN LANGUAGE FOR PACKING IN GTHRES. C IT IS NOT ACTUALLY NEEDED BECAUSE IPRTEL IS SET = 0 C INDICATING NO PACKING IPRTEL=0 C CALL GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 FD4,ND2X3,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NX,NY,MESH,AMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) C IF(IER.EQ.777)THEN C IER = 777 IS NOT FATAL. AN NDGD MASK MIGHT NOT BE C PROVIDED. WRITE(KFILDO,151) 151 FORMAT(/' ****THE NDGD CONUS SNOW MASK WAS NOT FOUND.', 1 ' THE SNOW ANALYSIS CANNOT BE CUT. NOT FATAL,', 2 ' BUT COUNTED AS AN ERROR. PROCEEDING.') ISTOP=ISTOP+1 GO TO 700 ENDIF C IF(MESH.EQ.MESHE)THEN C WHEN MESH = MESHE, NXE*NYE = NX*NY. THIS SHOULD C NORMALLY BE THE CASE. C WRITE(KFILDO,349) 349 FORMAT(/,' CLIPPING ARCHIVE GRID IN CCONSN.') C DO 350 JJ=1,NX*NY CCCCD WRITE(KFILDO,3495)JJ,P(JJ),FD4(JJ) CCCCD3495 FORMAT(' IN CCONSN--JJ,P(JJ),FD4(JJ)',I8,2F10.2) C IF(FD4(JJ).LT..5)THEN P(JJ)=9999. ENDIF C 350 CONTINUE C ELSE C NOTE THAT HIS OPTION SHOULD NOT HAPPEN AND HAS NOT C BEEN CHECKED OUT. C CALL CLIP(KFILDO,P,NX,NY,MESH,FD4,NXE,NYE,MESHE,IER) C WHEN MESH NE MESHE, THE DOUBLE INDEXING HAS TO BE DONE C IN A SUBROUTINE. NOTE THAT MESHE MUST NOT BE GREATER C THAN MESH. ALSO, MESH MUST BE EQUAL TO MESHE*2**M, C WHERE M IS A LOW (POSITIVE) INTEGER. C IF(IER.NE.0)THEN C A DIAGNOSTIC IS PRODUCED IN CLIP. THIS IS NOT A C FATAL ERROR, BUT THE GRID WILL NOT BE CLIPPED. ISTOP=ISTOP+1 IER=777 ENDIF C ENDIF C CD CALL TIMPR(KFILDO,KFILDO,'END CCONSN ') C 700 RETURN END