Appendix 5 - All "C" and FORTRAN source codes: /* COMPARE2.C compares a polygon attribute table and an ASCII text attribute */ /* file for differences both in the set of nodes (missing from one file) and */ /* in the attributes of the node. The files are assumed to be named */ /* .asc and .txt. The value of can be */ /* specified on the command line when the program is started. If it is not, */ /* the user will be prompted for the string. */ /* */ /* This version of the program does not require that the 2 files be sorted */ /* by node ID. It will simply read through the list of nodes in the the */ /* '.asc' file one at a time. For each of these nodes it will search the */ /* entire '.txt' file until it finds a matching ID. The attributes will then */ /* be compared. If no match is found an error message is generated. When */ /* the entire '.asc' file has been processed, the '.txt' file will be read */ /* one node at a time and the '.asc' file will be searched for a matching */ /* ID. The attributes won't be compared (they already were), but if no */ /* match is found then the appropriate error message will be generated. */ /* */ #include #include #include #define buffsize 81 main (argc, argv) int argc; char *argv[]; { int id1, ct1, ca1, cb1, cc1, sn1, sa1, sb1, sc1, sd1, fa1, fb1, fc1, n1; int id2, ct2, ca2, cb2, cc2, sn2, sa2, sb2, sc2, sd2, fa2, fb2, fc2, n2; int I, PolyASC[15], PolyTXT[15], Stat1, Stat2; int Matched; char CoverageName[40], input_name1[20], input_name2[20]; char buff1[buffsize]; char buff2[buffsize]; FILE *fin1, *fin2; /* Enter text file names */ if (argc > 1) { strcpy(CoverageName, argv[1]); I = strlen(CoverageName); CoverageName[I] = 0; } else { printf("Enter name of the coverage: "); gets(CoverageName); I = strlen(CoverageName); CoverageName[I] = 0; } /* strlwr(CoverageName); */ strcpy(input_name1, CoverageName); strcat(input_name1, ".asc"); strcpy(input_name2, CoverageName); strcat(input_name2, ".txt"); /* printf ("Enter name of polygon attribute table (coverage file) .asc: "); gets(input_name1); printf ("Enter name of original ice attribute (text file) .txt: "); gets(input_name2); */ /* check file existence */ if ((fin1 = fopen(input_name1, "r")) == NULL) { printf("Error opening coverage file %s \n", input_name1); exit(1); } if ((fin2 = fopen(input_name2, "r")) == NULL) { printf("Error opening text file %s \n", input_name2); exit(1); } /* read and format data */ Stat1 = 0; Stat2 = 0; /* Start by reading the entries in the coverage file one at a time. */ /* Read the ENTIRE ".txt" file to find a matching polygon. This way */ /* neither of the files has to be sorted. After this is done we will */ /* do a similar thing reading the ".txt" file and searching for a match */ /* in the coverage (".asc") file, but then only checking for existence of */ /* a matching record - not checking the contents. */ Stat1 = Read_ASC_Poly(fin1, PolyASC); while (Stat1 == 0) { id1 = PolyASC[0]; ct1 = PolyASC[1]; ca1 = PolyASC[2]; cb1 = PolyASC[3]; cc1 = PolyASC[4]; sn1 = PolyASC[5]; sa1 = PolyASC[6]; sb1 = PolyASC[7]; sc1 = PolyASC[8]; sd1 = PolyASC[9]; fa1 = PolyASC[10]; fb1 = PolyASC[11]; fc1 = PolyASC[12]; n1 = PolyASC[13]; Stat2 = Read_TXT_Poly(fin2, PolyTXT); Matched = 0; while (Stat2==0 && Matched==0) { id2 = PolyTXT[0]; ct2 = PolyTXT[1]; ca2 = PolyTXT[2]; cb2 = PolyTXT[3]; cc2 = PolyTXT[4]; sn2 = PolyTXT[5]; sa2 = PolyTXT[6]; sb2 = PolyTXT[7]; sc2 = PolyTXT[8]; sd2 = PolyTXT[9]; fa2 = PolyTXT[10]; fb2 = PolyTXT[11]; fc2 = PolyTXT[12]; n2 = PolyTXT[13]; if (id1 == id2) { Matched = 1; /* check attribute data for inconsistencies */ if (ct1 != ct2) printf ("ct not equal for polygon-id: %3d \n", id1); if (ca1 != ca2) printf ("ca not equal for polygon-id: %3d \n", id1); if (cb1 != cb2) printf ("cb not equal for polygon-id: %3d \n", id1); if (cc1 != cc2) printf ("cc not equal for polygon-id: %3d \n", id1); if (sn1 != sn2) printf ("sn not equal for polygon-id: %3d \n", id1); if (sa1 != sa2) printf ("sa not equal for polygon-id: %3d \n", id1); if (sb1 != sb2) printf ("sb not equal for polygon-id: %3d \n", id1); if (sc1 != sc2) printf ("sc not equal for polygon-id: %3d \n", id1); if (sd1 != sd2) printf ("sd not equal for polygon-id: %3d \n", id1); if (fa1 != fa2) printf ("fa not equal for polygon-id: %3d \n", id1); if (fb1 != fb2) printf ("fb not equal for polygon-id: %3d \n", id1); if (fc1 != fc2) printf ("fc not equal for polygon-id: %3d \n", id1); if (n1 != n2) printf ("n not equal for polygon-id: %3d \n", id1); } if (Matched==0) Stat2 = Read_TXT_Poly(fin2, PolyTXT); } if (Matched==0) printf("Polygon %3d is not in the text file %s\n", id1, input_name2); Stat1 = Read_ASC_Poly(fin1, PolyASC); rewind(fin2); /* rewind the file to the beginning */ } /* Now search for entries in the TXT file that are not in the ASC file. */ rewind(fin1); rewind(fin2); Stat2 = Read_TXT_Poly(fin2, PolyTXT); while (Stat2 == 0) { id2 = PolyTXT[0]; Stat1 = Read_ASC_Poly(fin1, PolyASC); Matched = 0; while (Stat1==0 && Matched==0) { id1 = PolyASC[0]; if (id1 == id2) Matched = 1; if (Matched==0) Stat1 = Read_ASC_Poly(fin1, PolyASC); } if (Matched==0) printf("Polygon %3d is not in the coverage file %s\n", id2, input_name1); Stat2 = Read_TXT_Poly(fin2, PolyTXT); rewind(fin1); /* rewind the file to the beginning */ } fclose(fin1); fclose(fin2); } /********************************************************/ int Read_ASC_Poly(Fin, PolyASC) FILE *Fin; int *PolyASC; { int I; char buff[120]; if (fgets(buff, 120, Fin) == NULL) return -1; /* irrelevant node number */ for (I=0; I<14; I++) { if (fgets(buff, 120, Fin) == NULL) return -1; sscanf(&buff[28], "%d", &PolyASC[I]); } return 0; /* zero = successful; -1 = failed */ } /********************************************************/ int Read_TXT_Poly(Fin, PolyTXT) FILE *Fin; int *PolyTXT; { int I, J; char buff[120]; if (fgets(buff, 120, Fin) == NULL) return -1; /* buffer contains all info */ /* check for empty line */ if (strncmp(buff, " ", 15) == 0) return -1; sscanf(&buff[0], "%d", &PolyTXT[0]); J = 5; for (I=1; I<5; I++) { sscanf(&buff[J], "%d", &PolyTXT[I]); J = J + 4; } for (I=5; I<14; I++) { sscanf(&buff[J], "%d", &PolyTXT[I]); J = J + 3; } return 0; /* zero = successful; -1 = failed */ } C i_mask_1.f C On the PC compile as: lf90 i_mask_1.f -win -fix C On the UNIX compile as: f77 -o i_mask_1 i_mask_1.f C Written by David Norton C READS A RASTER ICE CHART, RASTER 'GID' CELL CHART C CONTAINING ALL THE CELLS WITH DATA, AND THE RASTER MASK. C THIS PROGRAM ASSIGNS VALUES TO CELLS WHICH ARE LAKE CELLS C IN THE MASK BUT LAND CELLS IN THE GID. OUTPUT IS A NEW C RASTER GRID THAT MATCHES THE MASK. CHARACTER DUMY*1,NAME*10,GID_NAME*48,NEW_NAME*11,STRING*25, +ID*3 INTEGER ICE(516,510),GID(516,510),MASK(516,510),X,X1,X2,Y,Y1 C Read in the mask, 0 is land and 1 is water. OPEN(11,FILE='/gis/gid/named/basegrid.asc',STATUS='OLD', +recl=2000) READ(11,1000)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY 1000 FORMAT(A/A/A/A/A/A) IF(DUMY.EQ.'-')GOTO2 2 CONTINUE do j=1,510 READ(11,*)(MASK(i,j),i=1,516) enddo C print *,' mask input' C Open input and output list files. C CREATE THE INP FILE USING: DIR/B/O:N > ICEMASK1.INP C*.CT OPEN(12,FILE='i_mask_1.inp',STATUS='OLD') OPEN(16,FILE='i_mask_1.out',STATUS='NEW') OPEN(18,FILE='i_mask_1.num',STATUS='NEW') OPEN(20,FILE='i_mask_1.tem',STATUS='NEW',recl=2000) WRITE(18,5900) 5900 FORMAT(10X,'SUMMARY OF CELL CHANGES.'/10X,'MISSING DATA IS IN', +' INPUT WHILE ASSIGNED MISSING SHOULD BE CORRECTED BY EDITING.') C read the name of the ice chart 10 READ(12,1001,END=999)NAME 1001 FORMAT(A) C STOP ON A BLANK LINE IF(NAME(1:1).EQ.' ')GOTO999 WRITE(16,1100)NAME ID = 'x_x' IF(NAME(9:10).EQ.'ct')ID='c_t' IF(NAME(9:10).EQ.'ca')ID='c_a' IF(NAME(9:10).EQ.'cb')ID='c_b' IF(NAME(9:10).EQ.'cc')ID='c_c' IF(NAME(9:10).EQ.'sn')ID='s_n' IF(NAME(9:10).EQ.'sa')ID='s_a' IF(NAME(9:10).EQ.'sb')ID='s_b' IF(NAME(9:10).EQ.'sc')ID='s_c' IF(NAME(9:10).EQ.'sd')ID='s_d' IF(NAME(9:10).EQ.'fa')ID='f_a' IF(NAME(9:10).EQ.'fb')ID='f_b' IF(NAME(9:10).EQ.'fc')ID='f_c' IF(NAME(9:9) .EQ.'n' )ID='n_n' 1100 FORMAT(/,10X,A/10X,'Following MASK & ICE are the line and', +' column in the files'/10X,'using the PFE editor.'/10X, +'ICE ON LAND'/9X, +' X Y Value Ln Col Ln Col') LOI=0 IOL=0 IXX=0 C Assign the ice chart name to its GID file and the new output file. NEW_NAME = NAME(1:8)//ID if(name(1:1).eq.'u')then GID_NAME = '/gis/nic/gid/'//NAME(1:8)//'gid' else GID_NAME = '/gis/cis/gid/'//NAME(1:8)//'gid' endif OPEN(13,FILE=NAME,STATUS='OLD') OPEN(14,FILE=GID_NAME,STATUS='OLD',recl=2000) READ(14,1000)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY write(20,4997)gid_name 4997 format(/,5x,a) C Input the file with ice polygon numbers do j=1,510 READ(14,4999)(GID(i,j),i=1,516) 4999 format(515i3,I5) C There should never be a polygon id of 0, so stop processing, SET IT TO 1!! igid=0 do ii=1,516 IF(GID(ii,j).eq.0)then igid=1 GID(ii,j)=1 endif enddo if(igid.eq.1)write(20,5001)j,(gid(k,j),k=1,516) 5001 format(/,i5,5(100i3,/5x),16i3,i5) enddo C PRINT *,' GID INPUT' C The new output file will have the same heading as the ice C parameters input OPEN(15,FILE=NEW_NAME,STATUS='NEW',recl=2000) READ (13,1200)STRING(1:17) WRITE(15,1200)STRING(1:17) READ (13,1200)STRING(1:17) WRITE(15,1200)STRING(1:17) READ (13,1200)STRING(1:24) WRITE(15,1200)STRING(1:24) READ (13,1200)STRING(1:21) WRITE(15,1200)STRING(1:21) READ (13,1200)STRING(1:18) WRITE(15,1200)STRING(1:18) READ (13,1200)STRING(1:19) WRITE(15,1200)STRING(1:19) 1200 FORMAT(A) C Read in the ice data C COUNT MISSING DATA VALUES MISS=0 do j=1,510 READ(13,4999)(ICE(i,j),i=1,516) DO K=1,516 IF(ICE(K,j).EQ.-99)MISS=MISS+1 ENDDO enddo C PRINT *,' ICE INPUT' C Read in the Mask DO Y=1,510 DO X=1,516 IF(GID(X,Y).GT.400.AND.MASK(X,Y).EQ.0)THEN IOL=IOL+1 X1 = (2*X)-1 X2 = 3*X Y1 = Y+6 WRITE(16,2000)X,Y,ICE(X,Y),Y1,X1,Y1,X2 2000 FORMAT(9X,2I4,2x,I4,11X,' MASK:',I4,','I4, + ' ICE:',I4,','I4) ICE(X,Y)=-1 GOTO200 ENDIF IF(MASK(X,Y).EQ.0)THEN ICE(X,Y)=-1 GOTO200 ENDIF 200 CONTINUE ENDDO ENDDO C PRINT *,' ICE ON LAND DONE' WRITE(16,1300) 1300 FORMAT(/10X,'LAND ON ICE, VALUE ASSIGNED IS IN THE CENTER.'/10X, +' X Y Ln Col Ln', +' Col') C Use the Mask and GID file to determine adjustments to ice data file DO Y=2,509 DO X=2,515 C SKIP LAND IF(MASK(X,Y).EQ.0)GOTO350 C THERE SHOULD NEVER BE POLYGONS NUMBERED 300-400 IF((GID(X,Y).GE.300).AND.(GID(X,Y).LT.400))PRINT *, + ' *** POLYGON NUMBER ERROR OF',GID(X,Y),'AT',X,Y C SKIP ICE DATA, ALTHOUGH ICE POLYGONS NOW START AT 401, SOME EARLY C CHARTS HAVE SOME 200 SERIES NUMBERS FOR ICE IN CHANNELS. IF(GID(X,Y).GT.200)GOTO350 LOI=LOI+1 C NOT ICE, BUT SHOULD BE SO ASSIGN ICE(X,Y) A NEIGHBORING VALUE 250 CONTINUE if(ID(1:1).EQ.'c')THEN ICE(X,Y)=-99 else ICE(X,Y)=-9 endif IF(ICE(X-1,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y-1) GOTO300 ELSEIF(ICE(X-1,Y).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y) GOTO300 ELSEIF(ICE(X-1,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y+1) GOTO300 ELSEIF(ICE(X,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X,Y-1) GOTO300 ELSEIF(ICE(X,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X,Y+1) GOTO300 ELSEIF(ICE(X+1,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y-1) GOTO300 ELSEIF(ICE(X+1,Y).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y) GOTO300 ELSEIF(ICE(X+1,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y+1) GOTO300 ENDIF 300 CONTINUE C IF THERE WAS NO ICE ADJACENT TO THE CELL, ASSIGN MISSING DATA CODE IF(ICE(X,Y).EQ.-1)THEN ICE(X,Y)=-99 IXX=IXX+1 ENDIF C COMPUTE THE ROW AND COLUMN NUMBERS FOR CHANGES TO EASILY FIND THEM C WITH THE PFE EDITOR. X1 = (2*X)-1 X2 = 3*X Y1 = Y+6 WRITE(16,3000)X,Y,ICE(X-1,Y-1),ICE(X,Y-1),ICE(X+1,Y-1), +Y1,X1,Y1,X2,ICE(X-1,Y), +ICE(X,Y),ICE(X+1,Y),ICE(X-1,Y+1),ICE(X,Y+1),ICE(X+1,Y+1) 3000 FORMAT(9X,2I4,4X,3I4,4X,'MASK:',I4,','I4,' ICE:',I4,','I4, +/21X,3I4/21X,3I4) 350 CONTINUE ENDDO ENDDO PRINT *,NAME,' Processed to ',NEW_NAME do j=1,510 WRITE(15,4000)(ICE(i,j),i=1,516) enddo WRITE(18,6000)NAME,IOL,MISS,LOI,IXX 6000 FORMAT(/,10X,A,' ICE ON LAND =',I5, + ', MISSING DATA =',I5, + /20X,' LAND ON ICE =',I5, + ', ASSIGNED MISSING=',I5) close(13) c close(13,status='delete') close(14) GOTO10 999 CONTINUE 4000 FORMAT(515I3,I5) END c i_mask_2.f C On the PC compile as: lf90 i_mask_2.f -win -fix C On the UNIX compile as: f77 -o i_mask_2 i_mask_2.f C Written by David Norton C READS A RASTER ICE CHART, RASTER 'GID' CELL CHART C CONTAINING ALL THE CELLS WITH DATA, AND THE RASTER MASK. C THIS PROGRAM ASSIGNS VALUES TO CELLS WHICH ARE LAKE CELLS C IN THE MASK BUT LAND CELLS IN THE GID. OUTPUT IS A NEW C RASTER GRID THAT MATCHES THE MASK. CHARACTER DUMY*1,NAME*10,GID_NAME*48,NEW_NAME*11,STRING*25, +ID*3 INTEGER ICE(516,510),GID(516,510),MASK(516,510),X,X1,X2,Y,Y1 C Read in the mask, 0 is land and 1 is water. OPEN(11,FILE='/gis/gid/named/basegrid.asc',STATUS='OLD', +recl=2000) READ(11,1000)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY 1000 FORMAT(A/A/A/A/A/A) IF(DUMY.EQ.'-')GOTO2 2 CONTINUE do j=1,510 READ(11,*)(MASK(i,j),i=1,516) enddo C print *,' mask input' C Open input and output list files. C CREATE THE INP FILE USING: DIR/B/O:N > ICEMASK1.INP C*.CT OPEN(12,FILE='i_mask_1.inp',STATUS='OLD') OPEN(16,FILE='i_mask_1.out',STATUS='NEW') OPEN(18,FILE='i_mask_1.num',STATUS='NEW') OPEN(20,FILE='i_mask_1.tem',STATUS='NEW',recl=2000) WRITE(18,5900) 5900 FORMAT(10X,'SUMMARY OF CELL CHANGES.'/10X,'MISSING DATA IS IN', +' INPUT WHILE ASSIGNED MISSING SHOULD BE CORRECTED BY EDITING.') C read the name of the ice chart 10 READ(12,1001,END=999)NAME 1001 FORMAT(A) C STOP ON A BLANK LINE IF(NAME(1:1).EQ.' ')GOTO999 WRITE(16,1100)NAME ID = 'x_x' IF(NAME(9:10).EQ.'ct')ID='c_t' IF(NAME(9:10).EQ.'ca')ID='c_a' IF(NAME(9:10).EQ.'cb')ID='c_b' IF(NAME(9:10).EQ.'cc')ID='c_c' IF(NAME(9:10).EQ.'sn')ID='s_n' IF(NAME(9:10).EQ.'sa')ID='s_a' IF(NAME(9:10).EQ.'sb')ID='s_b' IF(NAME(9:10).EQ.'sc')ID='s_c' IF(NAME(9:10).EQ.'sd')ID='s_d' IF(NAME(9:10).EQ.'fa')ID='f_a' IF(NAME(9:10).EQ.'fb')ID='f_b' IF(NAME(9:10).EQ.'fc')ID='f_c' IF(NAME(9:9) .EQ.'n' )ID='n_n' 1100 FORMAT(/,10X,A/10X,'Following MASK & ICE are the line and', +' column in the files'/10X,'using the PFE editor.'/10X, +'ICE ON LAND'/9X, +' X Y Value Ln Col Ln Col') LOI=0 IOL=0 IXX=0 C Assign the ice chart name to its GID file and the new output file. NEW_NAME = NAME(1:8)//ID if(name(1:1).eq.'u')then GID_NAME = '/gis/gid/named/'//NAME(1:8)//'gid' else GID_NAME = '/gis/gid/'//NAME(1:8)//'gid' endif OPEN(13,FILE=NAME,STATUS='OLD') OPEN(14,FILE=GID_NAME,STATUS='OLD',recl=2000) READ(14,1000)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY write(20,4997)gid_name 4997 format(/,5x,a) C Input the file with ice polygon numbers do j=1,510 READ(14,*)(GID(i,j),i=1,516) 4999 format(515i3,I5) C There should never be a polygon id of 0, so stop processing... FUDGE, SET IT TO 1!! igid=0 do ii=1,516 IF(GID(ii,j).eq.0)then igid=1 GID(ii,j)=1 endif enddo if(igid.eq.1)write(20,5001)j,(gid(k,j),k=1,516) 5001 format(/,i5,5(100i3,/5x),16i3,i5) enddo C PRINT *,' GID INPUT' C The new output file will have the same heading as the ice C parameters input OPEN(15,FILE=NEW_NAME,STATUS='NEW',recl=2000) READ (13,1200)STRING(1:17) WRITE(15,1200)STRING(1:17) READ (13,1200)STRING(1:17) WRITE(15,1200)STRING(1:17) READ (13,1200)STRING(1:24) WRITE(15,1200)STRING(1:24) READ (13,1200)STRING(1:21) WRITE(15,1200)STRING(1:21) READ (13,1200)STRING(1:18) WRITE(15,1200)STRING(1:18) READ (13,1200)STRING(1:19) WRITE(15,1200)STRING(1:19) 1200 FORMAT(A) C Read in the ice data C COUNT MISSING DATA VALUES MISS=0 do j=1,510 READ(13,4999)(ICE(i,j),i=1,516) DO K=1,516 IF(ICE(K,j).EQ.-99)MISS=MISS+1 ENDDO enddo C PRINT *,' ICE INPUT' C Read in the Mask DO Y=1,510 DO X=1,516 IF(GID(X,Y).GT.400.AND.MASK(X,Y).EQ.0)THEN IOL=IOL+1 X1 = (2*X)-1 X2 = 3*X Y1 = Y+6 WRITE(16,2000)X,Y,ICE(X,Y),Y1,X1,Y1,X2 2000 FORMAT(9X,2I4,2x,I4,11X,' MASK:',I4,','I4, + ' ICE:',I4,','I4) ICE(X,Y)=-1 GOTO200 ENDIF IF(MASK(X,Y).EQ.0)THEN ICE(X,Y)=-1 GOTO200 ENDIF 200 CONTINUE ENDDO ENDDO C PRINT *,' ICE ON LAND DONE' WRITE(16,1300) 1300 FORMAT(/10X,'LAND ON ICE, VALUE ASSIGNED IS IN THE CENTER.'/10X, +' X Y Ln Col Ln', +' Col') C Use the Mask and GID file to determine adjustments to ice file DO Y=2,509 DO X=2,515 C SKIP LAND IF(MASK(X,Y).EQ.0)GOTO350 C THERE SHOULD NEVER BE POLYGONS NUMBERED 300-400 IF((GID(X,Y).GE.300).AND.(GID(X,Y).LT.400))PRINT *, + ' *** POLYGON NUMBER ERROR OF',GID(X,Y),'AT',X,Y C SKIP ICE DATA, ALTHOUGH ICE POLYGONS NOW START AT 401, SOME C EARLY CHARTS HAVE SOME 200 SERIES NUMBERS FOR ICE IN CHANNELS. IF(GID(X,Y).GT.200)GOTO350 LOI=LOI+1 C NOT ICE, BUT SHOULD BE SO ASSIGN ICE(X,Y) A NEIGHBORING VALUE 250 CONTINUE if(ID(1:1).EQ.'c')THEN ICE(X,Y)=-99 else ICE(X,Y)=-9 endif IF(ICE(X-1,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y-1) GOTO300 ELSEIF(ICE(X-1,Y).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y) GOTO300 ELSEIF(ICE(X-1,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X-1,Y+1) GOTO300 ELSEIF(ICE(X,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X,Y-1) GOTO300 ELSEIF(ICE(X,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X,Y+1) GOTO300 ELSEIF(ICE(X+1,Y-1).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y-1) GOTO300 ELSEIF(ICE(X+1,Y).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y) GOTO300 ELSEIF(ICE(X+1,Y+1).GT.-1)THEN ICE(X,Y)=ICE(X+1,Y+1) GOTO300 ENDIF 300 CONTINUE C IF THERE WAS NO ICE ADJACENT TO THE CELL, ASSIGN MISSING DATA C CODE IF(ICE(X,Y).EQ.-1)THEN ICE(X,Y)=-99 IXX=IXX+1 ENDIF C COMPUTE THE ROW AND COLUMN NUMBERS FOR CHANGES TO EASILY FIND C THEM C WITH THE PFE EDITOR. X1 = (2*X)-1 X2 = 3*X Y1 = Y+6 WRITE(16,3000)X,Y,ICE(X-1,Y-1),ICE(X,Y-1),ICE(X+1,Y-1), +Y1,X1,Y1,X2,ICE(X-1,Y), +ICE(X,Y),ICE(X+1,Y),ICE(X-1,Y+1),ICE(X,Y+1),ICE(X+1,Y+1) 3000 FORMAT(9X,2I4,4X,3I4,4X,'MASK:',I4,','I4,' ICE:',I4,','I4, +/21X,3I4/21X,3I4) 350 CONTINUE ENDDO ENDDO PRINT *,NAME,' Processed to ',NEW_NAME do j=1,510 WRITE(15,4000)(ICE(i,j),i=1,516) enddo WRITE(18,6000)NAME,IOL,MISS,LOI,IXX 6000 FORMAT(/,10X,A,' ICE ON LAND =',I5, + ', MISSING DATA =',I5, + /20X,' LAND ON ICE =',I5, + ', ASSIGNED MISSING=',I5) close(13) c close(13,status='delete') close(14) GOTO10 999 CONTINUE 4000 FORMAT(515I3,I5) END C imaskfix.f c Change water cells to land for the Niagara River, etc. c TO WORK, YOU MUST COMPILE AS: c LF90 imaskfix.f -WIN -fix c on the UNIX compile as: c f77 -o imaskfix imaskfix.f c the -o allows you to name the object file, as here imaskfix.o c written by David Norton CHARACTER NAME*18,STRING*25,name1*18 dimension idata(516,510) integer x,y open (unit=15,file='imaskfix.inp',status='old') 1 READ(15,1001,END=999)NAME 1001 FORMAT(A) C Rewrite the files for parameters ct through fc for this date. name1 = name(1:9)//'-'//name(11:11) open (unit=10,file=name,status='old',recl=2000) open (unit=11,file=name1,status='new',recl=2000) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:24) WRITE(11,1001)STRING(1:24) READ (10,1001)STRING(1:21) WRITE(11,1001)STRING(1:21) READ (10,1001)STRING(1:18) WRITE(11,1001)STRING(1:18) READ (10,1001)STRING(1:19) WRITE(11,1001)STRING(1:19) do j=1,510 read(10,2000)(idata(k,j),k=1,516) 2000 format(515i3,I5) enddo idata(412,337)=-1 idata(413,338)=-1 idata(414,338)=-1 idata(416,338)=-1 idata(413,339)=-1 idata(417,339)=-1 idata(413,340)=-1 idata(416,341)=-1 idata(415,342)=-1 idata(416,342)=-1 if(name(11:11).eq.'t')goto400 do y=2,509 do x=2,515 if(idata(x,y).eq.0)then if(name(9:9).eq.'c')then idata(x,y)=-99 else idata(x,y)=-9 endif IF(idata(X-1,Y-1).GT.0)THEN idata(X,Y)=idata(X-1,Y-1) GOTO300 ELSEIF(idata(X-1,Y).GT.0)THEN idata(X,Y)=idata(X-1,Y) GOTO300 ELSEIF(idata(X-1,Y+1).GT.0)THEN idata(X,Y)=idata(X-1,Y+1) GOTO300 ELSEIF(idata(X,Y-1).GT.0)THEN idata(X,Y)=idata(X,Y-1) GOTO300 ELSEIF(idata(X,Y+1).GT.0)THEN idata(X,Y)=idata(X,Y+1) GOTO300 ELSEIF(idata(X+1,Y-1).GT.0)THEN idata(X,Y)=idata(X+1,Y-1) GOTO300 ELSEIF(idata(X+1,Y).GT.0)THEN idata(X,Y)=idata(X+1,Y) GOTO300 ELSEIF(idata(X+1,Y+1).GT.0)THEN idata(X,Y)=idata(X+1,Y+1) GOTO300 ENDIF endif 300 CONTINUE enddo enddo 400 continue do j=1,510 write(11,2000)(idata(k,j),k=1,516) enddo CLOSE(10) close(11) GOTO 1 999 CONTINUE CLOSE(15) STOP END c rename1.f c TO WORK, YOU MUST COMPILE AS: c LF90 RENAME.F90 -WIN -fix c on the UNIX change the extension to 'f' and compile as: c f77 -o rename1 rename1.f c the -o allows you to name the object file, as here rename1.o c written by David Norton CHARACTER NAME*18,STRING*25,id*2,name1*18,name2*10,val(12)*2 dimension idata(516) data val/'ct','ca','cb','cc','sn','sa','sb','sc','sd', + 'fa','fb','fc'/ open (unit=15,file='rename1.inp',status='old') 1 READ(15,1001,END=999)NAME 1001 FORMAT(A) id='99' if(name(4:6).eq.'DEC')id='12' if(name(4:6).eq.'JAN')id='01' if(name(4:6).eq.'FEB')id='02' if(name(4:6).eq.'MAR')id='03' if(name(4:6).eq.'APR')id='04' if(name(4:6).eq.'MAY')id='05' if(name(4:6).eq.'dec')id='12' if(name(4:6).eq.'jan')id='01' if(name(4:6).eq.'feb')id='02' if(name(4:6).eq.'mar')id='03' if(name(4:6).eq.'apr')id='04' if(name(4:6).eq.'may')id='05' C Rewrite the files for parameters ct through fc for this date. do i=1,12 name1 = name(1:10)//val(i)//'value' name2 = name(1:3)//id//name(7:8)//'.'//val(i) open (unit=10,file=name1,status='old',recl=2000) open (unit=11,file=name2,status='new',recl=2000) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:24) WRITE(11,1001)STRING(1:24) READ (10,1001)STRING(1:21) WRITE(11,1001)STRING(1:21) READ (10,1001)STRING(1:18) WRITE(11,1001)STRING(1:18) READ (10,1001)STRING(1:19) WRITE(11,1001)STRING(1:19) do j=1,510 read(10,*,end=888)(idata(k),k=1,516) write(11,2000)(idata(k),k=1,516) 2000 format(515i3,I5) enddo 888 continue CLOSE(10) close(11) enddo C Rewrite the file for 'n' for this date. name1 = name(1:10)//'nvalue' name2 = name(1:3)//id//name(7:8)//'.n' open (unit=10,file=name1,status='old',recl=2000) open (unit=11,file=name2,status='new',recl=2000) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:24) WRITE(11,1001)STRING(1:24) READ (10,1001)STRING(1:21) WRITE(11,1001)STRING(1:21) READ (10,1001)STRING(1:18) WRITE(11,1001)STRING(1:18) READ (10,1001)STRING(1:19) WRITE(11,1001)STRING(1:19) do j=1,510 read(10,*,end=889)(idata(k),k=1,516) write(11,2000)(idata(k),k=1,516) enddo 889 continue CLOSE(10) close(11) GOTO 1 999 CONTINUE CLOSE(15) STOP END c renamgid.f to compute only GID files c E:\nic\rename2.f saves files in subdirectory ./named c TO WORK, YOU MUST COMPILE AS: c LF90 renamgid.f -WIN -fix c on the UNIX change the extension to 'f' and compile as: c f77 -o renamgid renamgid.f c the -o allows you to name the object file, as here renamgid.o c written by David Norton CHARACTER name*18,STRING*25,id*2,name2*20 dimension idata(516) open (unit=15,file='renamgid.inp',status='old') 1 READ(15,1001,END=999)NAME 1001 FORMAT(A) id='99' if(name(4:6).eq.'DEC')id='12' if(name(4:6).eq.'JAN')id='01' if(name(4:6).eq.'FEB')id='02' if(name(4:6).eq.'MAR')id='03' if(name(4:6).eq.'APR')id='04' if(name(4:6).eq.'MAY')id='05' if(name(4:6).eq.'dec')id='12' if(name(4:6).eq.'jan')id='01' if(name(4:6).eq.'feb')id='02' if(name(4:6).eq.'mar')id='03' if(name(4:6).eq.'apr')id='04' if(name(4:6).eq.'may')id='05' C Rewrite the file for 'gid' for this date. name2 = './named/'//name(1:3)//id//name(7:8)//'.gid' open (unit=10,file=NAME,status='old',recl=516) open (unit=11,file=name2,status='new',recl=516) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:17) WRITE(11,1001)STRING(1:17) READ (10,1001)STRING(1:24) WRITE(11,1001)STRING(1:24) READ (10,1001)STRING(1:21) WRITE(11,1001)STRING(1:21) READ (10,1001)STRING(1:18) WRITE(11,1001)STRING(1:18) READ (10,1001)STRING(1:19) WRITE(11,1001)STRING(1:19) do j=1,510 read(10,*,end=889)(idata(k),k=1,516) write(11,2000)(idata(k),k=1,516) 2000 format(515i3,i5) enddo 889 continue close(10) c CLOSE(10,status='delete') close(11) GOTO 1 999 CONTINUE CLOSE(15) STOP END /*********************************************************************** * sp2I5.c - converts ASCII file from single-space delimited to * * an I5,1X format * * Tim Hunter, 1/21/97 * * This is a crude program that simply converts a simple ASCII file * * that contains integer values which are separated by a single space * * into a file that has the same values, but written in an I5,1X * * format. It is assumed that the file contains only integer values. * * If that is not true, then this program will not work correctly. * * It WILL accept wildcards for the filespec and process all files * * matching the filespec. * ************************************************************************/ #include #include #include #include main (argc, argv) int argc; char *argv[]; { int I, J, Ch, Done; long Val, LNum; char CommandLine[100], NewName[40], OldName[40]; char Line[200], ValOut[10]; FILE *Fin, *Fout; /* ** Check for command line entry of filespec */ if (argc == 1) { printf("usage: spac2i51x [files] \n"); printf("converts specified file(s) to desired format by rewriting the\n"); printf("files with single-space delimiting replaced by I5,1X format.\n"); exit(0); } /* ** process the files */ for (I=1; I 0) { Line[J] = 0; sscanf(Line, "%ld", &Val); sprintf(ValOut, "%5ld ", Val); fputs(ValOut, Fout); J = 0; } } if (Ch != ' ') { Line[J] = Ch; J++; } } if (J > 0) { Line[J] = 0; sscanf(Line, "%ld", &Val); sprintf(ValOut, "%5ld ", Val); fputs(ValOut, Fout); J = 0; } fputc(Ch, Fout); } fclose(Fin); fclose(Fout); } printf("Finished. %d files processed\n", I-1); } c summar1.f, does not use path, files must be in working area. c output is in percents, not cell counts c C summary.f produces a summary file for an input file of coverages. C written by David Norton c gis 24: ls > summary.inp *.c-t C summary.inp contains all *.c_t file names, and the C program will summarize all 13 parameters. C On the PC compile as: lf90 summary.f -win -fix C On the UNIX compile as: f77 -o summary summary.f CHARACTER DUMY*1,NAME*11,namex*48,ix(11:23)*3,path*4 INTEGER data(516),sum(11:23),per(11:23) data ix/'c-t','c-a','c-b','c-c','s-n','s-a','s-b','s-c','s-d', +'f-a','f-b','f-c','n-n'/ OPEN(10,FILE='summary.inp',STATUS='OLD') open(11,file='summary.out',status='new') write(11,1500) write(11,2000) C read the name of the ice chart 10 READ(10,1001,END=999)NAME 1001 FORMAT(A) if (name(4:5).eq.'12')then if(name(2:3).eq.'88') path = '8889' if(name(2:3).eq.'89') path = '8990' if(name(2:3).eq.'90') path = '9091' if(name(2:3).eq.'91') path = '9192' if(name(2:3).eq.'92') path = '9293' if(name(2:3).eq.'93') path = '9394' if(name(2:3).eq.'94') path = '9495' else if(name(2:3).eq.'89') path = '8889' if(name(2:3).eq.'90') path = '8990' if(name(2:3).eq.'91') path = '9091' if(name(2:3).eq.'92') path = '9192' if(name(2:3).eq.'93') path = '9293' if(name(2:3).eq.'94') path = '9394' if(name(2:3).eq.'95') path = '9495' endif do i=11,23 sum(i)=0 namex = name(1:8)//ix(i) c namex = '/d5/usd5/'//path//'/grids/ascii/'//NAME(1:8)//ix(i) OPEN(25,file=namex,status='old') READ(25,1000)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY do j=1,510 READ(25,4999)(data(k),k=1,515) do n=1,515 if(data(n).ge.0)sum(i) = sum(i)+1 enddo enddo close(25) enddo do i=11,23 per(i)=(((sum(i)/38193.0)*100.)+0.5) enddo write(11,5000)name(1:7),(per(m),m=11,23) GOTO10 999 CONTINUE 1000 format(a) 1500 format('Percentage: # of cells assigned / 38,193 possible.', +' (> .5 rounded up)',/) 2000 format('Coverage ct ca cb cc sn sa sb sc sd fa fb', +' fc n') 4999 format(515i3,I5) 5000 format(1x,a,13i4) END c summary13.f produces a grid with % of data per cell for each of c the 13 parameters. C written by David Norton c gis 24: ls > summary.inp *.c-t C summary.inp contains all *.c_t file names, and the C program will summarize all 13 parameters. C On the PC compile as: lf90 summary13.f -win -fix C On the UNIX compile as: f77 -o summary13 summary13.f CHARACTER DUMY*15,NAME*11,namex*48,ix(11:23)*3,path*4, +name13*12 INTEGER*2 data(516),percent(11:23,516,510) data ix/'c-t','c-a','c-b','c-c','s-n','s-a','s-b','s-c','s-d', +'f-a','f-b','f-c','n-n'/ do i=11,23 do j=1,516 do k=1,510 percent(i,j,k)=0 enddo enddo enddo OPEN(10,FILE='summary13.inp',STATUS='OLD') icount=0 C read the name of the ice chart 10 READ(10,1001,END=999)NAME icount=icount+1 print *, "read name ",name 1001 FORMAT(A) if (name(4:5).eq.'12')then if(name(2:3).eq.'72') path = '7273' if(name(2:3).eq.'73') path = '7374' if(name(2:3).eq.'74') path = '7475' if(name(2:3).eq.'75') path = '7576' if(name(2:3).eq.'76') path = '7677' if(name(2:3).eq.'77') path = '7778' if(name(2:3).eq.'78') path = '7879' if(name(2:3).eq.'79') path = '7980' if(name(2:3).eq.'80') path = '8081' if(name(2:3).eq.'81') path = '8182' if(name(2:3).eq.'82') path = '8283' if(name(2:3).eq.'83') path = '8384' if(name(2:3).eq.'84') path = '8485' if(name(2:3).eq.'85') path = '8586' if(name(2:3).eq.'86') path = '8687' if(name(2:3).eq.'87') path = '8788' if(name(2:3).eq.'88') path = '8889' if(name(2:3).eq.'89') path = '8990' if(name(2:3).eq.'90') path = '9091' if(name(2:3).eq.'91') path = '9192' if(name(2:3).eq.'92') path = '9293' if(name(2:3).eq.'93') path = '9394' if(name(2:3).eq.'94') path = '9495' else if(name(2:3).eq.'73') path = '7273' if(name(2:3).eq.'74') path = '7374' if(name(2:3).eq.'75') path = '7475' if(name(2:3).eq.'76') path = '7576' if(name(2:3).eq.'77') path = '7677' if(name(2:3).eq.'78') path = '7778' if(name(2:3).eq.'79') path = '7879' if(name(2:3).eq.'80') path = '7980' if(name(2:3).eq.'81') path = '8081' if(name(2:3).eq.'82') path = '8182' if(name(2:3).eq.'83') path = '8283' if(name(2:3).eq.'84') path = '8384' if(name(2:3).eq.'85') path = '8485' if(name(2:3).eq.'86') path = '8586' if(name(2:3).eq.'87') path = '8687' if(name(2:3).eq.'88') path = '8788' if(name(2:3).eq.'89') path = '8889' if(name(2:3).eq.'90') path = '8990' if(name(2:3).eq.'91') path = '9091' if(name(2:3).eq.'92') path = '9192' if(name(2:3).eq.'93') path = '9293' if(name(2:3).eq.'94') path = '9394' if(name(2:3).eq.'95') path = '9495' endif do i=11,23 if(name(1:1).eq.'c')then namex = '/gis/cis/'//path//'/ascii/'//NAME(1:8)//ix(i) else namex = '/gis/nic/'//path//'/ascii/'//NAME(1:8)//ix(i) endif OPEN(25,file=namex,status='old') READ(25,1000,end=666)DUMY,DUMY,DUMY,DUMY,DUMY,DUMY print *, " Processing file ",namex do j=1,510 READ(25,4999,end=666)(data(k),k=1,516) do n=1,516 if(data(n).eq.-1)percent(i,n,j)=-1 if(data(n).ge.0)percent(i,n,j)=percent(i,n,j)+1 enddo enddo goto777 666 print *, 'End of file on',namex,' at line ',j 777 close(25) enddo GOTO10 999 CONTINUE do i=11,23 do j=1,516 do k=1,510 if(percent(i,j,k).ne.-1)then percent(i,j,k)=(((percent(i,j,k)/icount)*100.)+0.5) endif enddo enddo enddo do i=11,23 name13= ix(i)//'.per' open(i,file=name13,status='new') write(i,6666) do k=1,510 write(i,4999)(percent(i,j,k),j=1,516) enddo enddo 1000 format(a) 1500 format('Percentage: # of cells assigned / # of Ct cells >', +' 10%; >.5 rounded up.',/) 2000 format('Coverage ct ca cb cc sn sa sb sc sd fa fb', +' fc n cells') 4999 format(515i3,I5) 5000 format(1x,a,13i4,i6) 6666 format('ncols 516',/, +'nrows 510',/,'xllcorner -649446.25',/, +'yllcorner 3306260',/,'cellsize 2550',/, +'NODATA_value -9999') END c tabulate1.f has # of charts per 7 day increments c d/programs/ c tabulate.f creates a tabular summary of dates from "gid" files dimension idata(1973:1995,334:516),istring(1973:1995,70), + icount(1973:1995) do i=1973,1995 do j=334,516 idata(i,j)=0 enddo enddo do k=1973,1995 icount(k)=0 enddo open(10,file='tabulate.inp',status='old') open(11,file='tabulate1.1',status='new') open(12,file='tabulate1.2',status='new') open(15,file='tabulate1.3',status='new') 10 read(10,1000,end=888)iy,im,id 1000 format(1x,3i2) if(im.ne.12)then iyear=1900+iy else iyear=1901+iy endif if(iy.eq.76)goto200 if(iy.eq.80)goto200 if(iy.eq.84)goto200 if(iy.eq.88)goto200 if(iy.eq.92)goto200 if(im.eq.12)iday=333+id if(im.eq.1) iday=364+id if(im.eq.2) iday=395+id if(im.eq.3) iday=423+id if(im.eq.4) iday=454+id if(im.eq.5) iday=484+id goto300 200 continue c leap years if(im.eq.12)iday=333+id if(im.eq.1) iday=364+id if(im.eq.2) iday=395+id if(im.eq.3) iday=424+id if(im.eq.4) iday=455+id if(im.eq.5) iday=485+id 300 continue idata(iyear,iday)=1 icount(iyear)=icount(iyear)+1 istring(iyear,(icount(iyear)))=iday goto10 888 continue do i=1973,1995 write(11,2000)i,(idata(i,j),j=334,516) write(12,3000)i,(istring(i,k),k=1,icount(i)) enddo itotal=0 do j=334,509,7 isum=0 do i=1973,1995 isum=isum+idata(i,j)+idata(i,j+1)+idata(i,j+2)+ 1 idata(i,j+3)+idata(i,j+4)+idata(i,j+5)+idata(i,j+6) enddo write(15,4000)j,j+6,isum itotal=itotal+isum enddo write(15,5000)itotal 2000 format(i5,185(',',i1)) 3000 format(i5,70(',',i3)) 4000 format(1x,i3,'-',i3,i5) 5000 format(' total ', i6) stop end