C================================================================== C PROGRAM TO INTEGRATE ONE DEGREE GRIDDED CO2 FOSSIL FUEL C EMISSION DATA WITH INFORMATION ON LOCATION, COUNTRY NAMES C AND COUNTRY IDENTIFICATION CODES FOR THE YEARS 1950, 1960, 1970 C 1980 AND 1990. NOTE THAT COUNTRY AND POLITICAL UNIT NAMES C CHANGE OVER TIME. C C WHERE: C GEIAID = 1000*JGRID+IGRID C TLAT(ITUDE) = (JGRID-91)+0.5 (DEGREES) C TLONG(ITUDE) = (IGRID-181)+0.5 (DEGREES) C FF = CO2 EMISSION FROM FOSSIL FUELS C (1000 METRIC TONS C / GRID CELL / YEAR) C IDUN = UNITED NATIONS COUNTRY CODE C GNAME = UNITED NATIONS COUNTRY NAME C IGIS = NASA-GISS COUNTRY NAME C IJCODE = NASA-GISS COUNTRY/PROVINCE-REGION CODE C CIJNAME = NASA-GISS COUNTRY/PROVINCE-REGION NAME C C================================================================== REAL*8 FF(180,360) INTEGER IJCODE(180,360) INTEGER IGIS(180,360) CHARACTER*40 CIJNAME(180,360) INTEGER IDUN(180,360) CHARACTER*42 GNAME(180,360) INTEGER ICODE(355) CHARACTER*14 CNAME(355) INTEGER IIDUN(217),IIGISS(217) CHARACTER*42 GINAME(217) CHARACTER*6 GEIAID INTEGER YEAR REAL*8 SUM C OPEN(40,FILE='CNTRY1X1.COD',STATUS='OLD') OPEN(50,FILE='GISSUN.COD',STATUS='OLD') C INITIATE DO I=1,180 DO J=1,360 FF(I,J)=0.D0 IJCODE(I,J)=0 IGIS(I,J)=0 CIJNAME(I,J)=' ' IDUN(I,J)=0 GNAME(I,J)=' ' ENDDO ENDDO DO IJ=1,5 SUM=0.D0 IF(IJ.EQ.1) YEAR=1950 IF(IJ.EQ.2) YEAR=1960 IF(IJ.EQ.3) YEAR=1970 IF(IJ.EQ.4) YEAR=1980 IF(IJ.EQ.5) YEAR=1990 IF(IJ.EQ.1) OPEN(10,FILE='GRIDCAR.50',STATUS='OLD') IF(IJ.EQ.2) OPEN(10,FILE='GRIDCAR.60',STATUS='OLD') IF(IJ.EQ.3) OPEN(10,FILE='GRIDCAR.70',STATUS='OLD') IF(IJ.EQ.4) OPEN(10,FILE='GRIDCAR.80',STATUS='OLD') IF(IJ.EQ.5) OPEN(10,FILE='GRIDCAR.90',STATUS='OLD') IF(IJ.EQ.1) OPEN(30,FILE='GRIDALL.50',STATUS='UNKNOWN') IF(IJ.EQ.2) OPEN(30,FILE='GRIDALL.60',STATUS='UNKNOWN') IF(IJ.EQ.3) OPEN(30,FILE='GRIDALL.70',STATUS='UNKNOWN') IF(IJ.EQ.4) OPEN(30,FILE='GRIDALL.80',STATUS='UNKNOWN') IF(IJ.EQ.5) OPEN(30,FILE='GRIDALL.90',STATUS='UNKNOWN') OPEN(20,FILE='CNTYMOD.DAT',STATUS='OLD') TLONG=-179.5 TLAT=90.5 C FROM NORTH > SOUTH DO 10 I=1,180 TLAT=TLAT-1.D0 TLONG=-179.5 C FROM WEST > EAST: DO 10 J=1,360 C WRITE OUT EACH GRIDCELL: JGRID=TLAT+91.D0-0.5D0 IGRID=TLONG+181.D0-0.5D0 C GEIAID='000000' IF (JGRID.LE.9) THEN WRITE (GEIAID(3:3),'(I1)') JGRID ELSEIF (JGRID.LE.99) THEN WRITE (GEIAID(2:3),'(I2)') JGRID ELSEIF (JGRID.LE.999) THEN WRITE (GEIAID(1:3),'(I3)') JGRID ENDIF IF (IGRID.LE.9) THEN WRITE (GEIAID(6:6),'(I1)') IGRID ELSEIF (IGRID.LE.99) THEN WRITE (GEIAID(5:6),'(I2)') IGRID ELSEIF (IGRID.LE.999) THEN WRITE (GEIAID(4:6),'(I3)') IGRID ENDIF READ(10,*)FF(I,J) READ(20,'(I6)')IJCODE(I,J) C PROCESS CHANGES OVER TIME: C C CZECHOSLOVAKIA IF (IJCODE(I,J).EQ.4102) IJCODE(I,J)=4100 IF (IJCODE(I,J).EQ.4101) IJCODE(I,J)=4100 C EAST & WEST PAKISTAN SPLIT AFTER 1971 INTO BANGLADESH AND PAKISTAN IF ((YEAR.LT.1972).AND.(IJCODE(I,J).EQ.1200)) 1 IJCODE(I,J)=20300 IF ((YEAR.LT.1972).AND.(IJCODE(I,J).EQ.12400)) 1 IJCODE(I,J)=20300 IF (IJCODE(I,J).EQ.20300) CIJNAME(I,J)='E&W PAKISTAN' C FRENCH INDO-CHINA SPLITS IN 1954 INTO CAMBODIA, LAOS, AND THE VIETNAMS IF ((YEAR.LT.1955).AND.(IJCODE(I,J).EQ.8600)) 1 IJCODE(I,J)=20700 IF ((YEAR.LT.1955).AND.(IJCODE(I,J).EQ.9200)) 1 IJCODE(I,J)=20700 IF ((YEAR.LT.1955).AND.(IJCODE(I,J).EQ.17601)) 1 IJCODE(I,J)=20700 IF ((YEAR.LT.1955).AND.(IJCODE(I,J).EQ.17602)) 1 IJCODE(I,J)=20700 IF (IJCODE(I,J).EQ.17601) CIJNAME(I,J)='DEM. REP.VIETNAM' IF (IJCODE(I,J).EQ.17602) CIJNAME(I,J)='S VIETNAM REPUBLIC' IF (IJCODE(I,J).EQ.20700) CIJNAME(I,J)='FR INDO-CHINA' C VIETNAM IF (YEAR.GE.1970.AND. &IJCODE(I,J).GE.17601.AND.IJCODE(I,J).LE.17602) & IJCODE(I,J)=17600 C MALAYA SINGAPORE SPLITS IN 1957 INTO SINGAPORE AND PENINSULAR MALAYSIA IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.10101)) 1 IJCODE(I,J)=21000 IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.14600)) 1 IJCODE(I,J)=21000 IF (IJCODE(I,J).EQ.21000) CIJNAME(I,J)='MALAY SINGAPORE' IF (YEAR.GT.1959.AND.IJCODE(I,J).EQ.10101) 1 IJCODE(I,J)=10100 IF (IJCODE(I,J).EQ.10101) CIJNAME(I,J)='PEN MALAYSIA' C WAS SABAH IF (YEAR.GE.1970.AND.IJCODE(I,J).EQ.10102) IJCODE(I,J)=10100 IF (IJCODE(I,J).EQ.10102) CIJNAME(I,J)='SABAH' C WAS SARAWAK IF (YEAR.GE.1970.AND.IJCODE(I,J).EQ.10103) IJCODE(I,J)=10100 IF (IJCODE(I,J).EQ.10103) CIJNAME(I,J)='SARAWAK' C RWANDA-URUNDI SPLIT AFTER 1961 INTO RWANDA AND BURUNDI IF ((YEAR.LT.1962).AND.(IJCODE(I,J).EQ.2600)) 1 IJCODE(I,J)=20400 IF ((YEAR.LT.1962) .AND.(IJCODE(I,J).EQ. 13600)) 1 IJCODE(I,J)=20400 IF (IJCODE(I,J).EQ.20400) CIJNAME(I,J)='RWANDA-URUNDI' C RHODESIA-NYASALAND SPLIT AFTER 1963 INTO MALAWI, ZAMBIA, ZIMBABWE IF ((YEAR.LT.1964).AND.(IJCODE(I,J).EQ.10000)) 1 IJCODE(I,J)=20500 IF ((YEAR.LT.1964).AND.(IJCODE(I,J).EQ.18300)) 1 IJCODE(I,J)=20500 IF ((YEAR.LT.1964).AND.(IJCODE(I,J).EQ.18400)) 1 IJCODE(I,J)=20500 IF (IJCODE(I,J).EQ.20500) CIJNAME(I,J)='RHODESIA-NYASALND' C FRENCH EQUATORIAL AFRICA SPLITS IN 1959 INTO CENTRAL AFRICAN REPUBLIC, C CHAD, CONGO AND GABON IF ((YEAR.LT.1959).AND.(IJCODE(I,J).EQ.3000)) 1 IJCODE(I,J)=20800 IF ((YEAR.LT.1959).AND.(IJCODE(I,J).EQ.3100)) 1 IJCODE(I,J)=20800 IF ((YEAR.LT.1959).AND.(IJCODE(I,J).EQ.3600)) 1 IJCODE(I,J)=20800 IF ((YEAR.LT.1959).AND.(IJCODE(I,J).EQ.5800)) 1 IJCODE(I,J)=20800 IF (IJCODE(I,J).EQ.20800) CIJNAME(I,J)='CHAD,CONGO,GABON' C FRENCH WEST AFRICA SPLITS IN 1958 INTO BENIN, BURKINA FASO, COTE DE IVOIRE, C GUINEA, MALI, MAURITANIA, NIGER, SENEGAL IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.1600)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.2400)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.6700)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.8200)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.10300)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.10600)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.12000)) 1 IJCODE(I,J)=20900 IF ((YEAR.LT.1958).AND.(IJCODE(I,J).EQ.14300)) 1 IJCODE(I,J)=20900 IF (IJCODE(I,J).EQ.20900) CIJNAME(I,J)='FR W AFRICA ' C TANZANIA IF (YEAR.GE.1970.AND. &IJCODE(I,J).GE.15901.AND.IJCODE(I,J).LE.15902) & IJCODE(I,J)=15900 IF (IJCODE(I,J).EQ.15901) CIJNAME(I,J)='TANGANYIKA' IF (IJCODE(I,J).EQ.15902) CIJNAME(I,J)='ZANZIBAR' C PANAMA IF (YEAR.GE.1980.AND. &IJCODE(I,J).GE.12601.AND.IJCODE(I,J).LE.12602) & IJCODE(I,J)=12600 IF (IJCODE(I,J).EQ.12601) CIJNAME(I,J)='PANAMA CAN Z' IF (IJCODE(I,J).EQ.12602) CIJNAME(I,J)='PANAMA ' C NETHERLANDS ANTILLES AND ARUBA SPLIT AFTER 1985 IF ((YEAR.LT.1985).AND.(IJCODE(I,J).EQ.11600)) 1 IJCODE(I,J)=20200 IF ((YEAR.LT.1985).AND.(IJCODE(I,J).EQ.18700)) 1 IJCODE(I,J)=20200 IF (IJCODE(I,J).EQ.20200) CIJNAME(I,J)='N ANTILLES AND ARUBA' IF (IJCODE(I,J).EQ.18700) CIJNAME(I,J)='ARUBA' C LEEWARD ISLANDS SPLITS IN 1957 INTO ANTIGUA & BARBUDA, BRITISH VIRGIN C ISLANDS, MONTSERRAT AND SAINT KITTS-NEVIS IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.600)) 1 IJCODE(I,J)=20600 IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.13700)) 1 IJCODE(I,J)=20600 IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.18800)) 1 IJCODE(I,J)=20600 IF(IJCODE(I,J).EQ.18800) CIJNAME(I,J)='BRITISH V.ISLANDS' IF ((YEAR.LT.1957).AND.(IJCODE(I,J).EQ.19400)) 1 IJCODE(I,J)=20600 IF (IJCODE(I,J).EQ.19400) CIJNAME(I,J)='MONTSERRAT' IF (IJCODE(I,J).EQ.20600) CIJNAME(I,J)='LEEWARD ISLANDS' C ST. KITTS-NEVIS-ANGUILLA SPLITS AFTER 1980 IF ((YEAR.LT.1981).AND.(IJCODE(I,J) .EQ.13700)) 1 IJCODE(I,J)=20100 IF ((YEAR.LT.1981).AND.(IJCODE(I,J).EQ.500)) 1 IJCODE(I,J)=20100 C ANGUILLA (500) HAS NO UN-ID (KEEP UNID == 658 FROM BEFORE SPLIT ? ) IF (IJCODE(I,J).EQ.500.AND.YEAR.GT.1980) IDUN(I,J)=658 IF (IJCODE(I,J).EQ.500) GNAME(I,J)='ANGUILLA ' IF (IJCODE(I,J).EQ.20100) CIJNAME(I,J)='ST.KITTS-NEV-ANG' C RYUKU ISLANDS HAS DATA FOR 1950-1972, OTHERWISE INCLUDED IN JAPAN IF ((YEAR.GT.1972).AND.(IJCODE(I,J).EQ.19700)) THEN IJCODE(I,J)=8400 IGIS(I,J)=8400 ENDIF IF (IJCODE(I,J).EQ.19700) CIJNAME(I,J)='RYUKU ISLANDS' C CHRISTMAS ISLAND HAS DATA FOR 1970-1983, OTHERWISE INCLUDED IN AUSTRALIA IF ((YEAR.GT.1969).AND.(YEAR.LT.1984)) THEN IF (IJCODE(I,J).EQ.19100) CIJNAME(I,J)='XMAS ISLAND' GOTO 99 ELSE IF (IJCODE(I,J).EQ.19100) CIJNAME(I,J)='XMAS ISLAND' IF (IJCODE(I,J).EQ.19100) IJCODE(I,J)=800 C XMAS ISLAND WILL BE OVERRIDDEN BY IJCODE(I,J)>EQ.800'S NAME AUSTRALIA 99 ENDIF C AUSTRALIA IF (IJCODE(I,J).GE.800.AND.IJCODE(I,J).LE.807) THEN IDUN(I,J)=36 IGIS(I,J)=800 GNAME(I,J)='AUSTRALIA' ENDIF C BRAZIL IF (IJCODE(I,J).GE.2100.AND.IJCODE(I,J).LE.2125) THEN IDUN(I,J)=76 IGIS(I,J)=2100 GNAME(I,J)='BRAZIL' ENDIF C CANADA IF (IJCODE(I,J).GE.2800.AND.IJCODE(I,J).LE.2812) THEN IDUN(I,J)=124 IGIS(I,J)=2800 GNAME(I,J)='CANADA' ENDIF C CHINA IF (IJCODE(I,J).GE.3300.AND.IJCODE(I,J).LE.3329) THEN IDUN(I,J)=156 IGIS(I,J)=3300 GNAME(I,J)='CHINA (MAINLAND)' ENDIF C INDIA IF (IJCODE(I,J).GE.7501.AND.IJCODE(I,J).LE.7525) THEN IDUN(I,J)=356 IGIS(I,J)=7500 GNAME(I,J)='INDIA' ENDIF C USA IF (IJCODE(I,J).GE.17101.AND.IJCODE(I,J).LE.17151 &.AND.IDUN(I,J).NE.630) THEN IDUN(I,J)=840 IGIS(I,J)=17100 GNAME(I,J)='UNITED STATES OF AMERICA' ENDIF IF (IJCODE(I,J).EQ.17151) GNAME(I,J)='PUERTO RICO' C USSR IF (IJCODE(I,J).GE.17201.AND.IJCODE(I,J).LE.17215) THEN IDUN(I,J)=810 IGIS(I,J)=17200 GNAME(I,J)='USSR' ENDIF C AMERICAN SAMOA IF (IJCODE(I,J).EQ.18500) CIJNAME(I,J)='AM SAMOA' C U.S VIRGIN ISLANDS IF (IJCODE(I,J).EQ.18900) CIJNAME(I,J)='US V ISLANDS' C CAYMAN ISLANDS IF (IJCODE(I,J).EQ.19000) CIJNAME(I,J)='CAYMAN ISLANDS' C GIBRALTAR IF (IJCODE(I,J).EQ.19200) CIJNAME(I,J)='GIBRALTAR' C MACAU IF (IJCODE(I,J).EQ.19300) CIJNAME(I,J)='MACAU' C NIUE IF (IJCODE(I,J).EQ.19500) CIJNAME(I,J)='NIUE' C PACIFIC ISLANDS IF (IJCODE(I,J).EQ.19600) CIJNAME(I,J)='PAC ISLANDS' C SAINT HELENA IF (IJCODE(I,J).EQ.19800) CIJNAME(I,J)='ST HELENA' C ST PIERRE IF (IJCODE(I,J).EQ.19900) CIJNAME(I,J)='ST PIERRE' C WAKE ISLAND IF (IJCODE(I,J).EQ.20000) CIJNAME(I,J)='WAKE ISLAND' C ANTARCTICA IF (IJCODE(I,J).EQ.25300) CIJNAME(I,J)='ANTARCTICA' C ANTARCTIC FISHERIES IF (IJCODE(I,J).EQ.18600) CIJNAME(I,J)='ANTARCTIC FISH' C C LESOTHO (9400) HAS NO FOSSIL FUEL EMISSION DATA C IF (IJCODE(I,J).EQ.9400) IDUN(I,J)=426 C NAMIBIA (11200) HAS NO FOSSIL FUEL EMISSION DATA C IF (IJCODE(I,J).EQ.11200) IDUN(I,J)=516 C TUVALU (16700) HAS NO FOSSIL FUEL EMISSION DATA AND NO UN-ID C ANTARCTICA (25300) HAS NO FF EMISSION DATA NOR UN-ID C KERGUELEN (25500) HAS NO FF EMISSION DATA NOR UN-ID C ANGUILLA (500) HAS NO IGIS-CODE NOR UN-ID C DO K=1,355 IF(I.EQ.1.AND.J.EQ.1.AND.IJ.EQ.1) & READ (40,'(I6,5X,A14)') ICODE(K),CNAME(K) ENDDO DO K=1,355 IF (ICODE(K).EQ.IJCODE(I,J)) THEN CIJNAME(I,J)=CNAME(K) GOTO 911 ENDIF ENDDO 911 CONTINUE DO K=1,217 IF(I.EQ.1.AND.J.EQ.1.AND.IJ.EQ.1) & READ(50,'(6X,I3,4X,I6,2X,A42)') & IIDUN(K),IIGISS(K),GINAME(K) ENDDO DO K=1,217 IF (IIGISS(K).EQ.IJCODE(I,J)) THEN GNAME(I,J)=GINAME(K) IDUN(I,J)=IIDUN(K) IGIS(I,J)=IIGISS(K) GOTO 912 ENDIF ENDDO 912 CONTINUE IF(I.EQ.1.AND.J.EQ.1.AND.IJ.EQ.1) CLOSE(UNIT=40) IF(I.EQ.1.AND.J.EQ.1.AND.IJ.EQ.1) CLOSE(UNIT=50) WRITE(30,'(A6,2X,2(F6.1,2X),G12.6,2X, &I3,2X,A42,2X, &I6,2X,I6,2X,A14)') &GEIAID,TLAT,TLONG,FF(I,J), &IDUN(I,J),GNAME(I,J), &IGIS(I,J),IJCODE(I,J),CIJNAME(I,J) C SUM=SUM+FF(I,J) TLONG=TLONG+1.D0 10 CONTINUE C PRINT *,'IN YEAR:',YEAR,' CO2 EMISSIONS=',SUM, &' IN 1000 METRIC TONS C' C IN YEAR: 1950 CO2 EMISSIONS= 1588607.5 IN 1000 METRIC TONS C C IN YEAR: 1960 CO2 EMISSIONS= 2505231.8 IN 1000 METRIC TONS C C IN YEAR: 1970 CO2 EMISSIONS= 3861021.8 IN 1000 METRIC TONS C C IN YEAR: 1980 CO2 EMISSIONS= 5042867.8 IN 1000 METRIC TONS C C IN YEAR: 1990 CO2 EMISSIONS= 5811613.7 IN 1000 METRIC TONS C C CLOSE (UNIT=10) CLOSE (UNIT=20) CLOSE (UNIT=30) REWIND 10 REWIND 20 REWIND 30 C CLEAN: DO I=1,180 DO J=1,360 FF(I,J)=0.D0 IJCODE(I,J)=0 IGIS(I,J)=0 CIJNAME(I,J)=' ' IDUN(I,J)=0 GNAME(I,J)=' ' ENDDO ENDDO ENDDO STOP END C==================================================================