cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO OO cO This program writes the TransCom 3 Level 2 output data to a series OO cO of netCDF files. To search for what changes need to be made to OO cO this code search for the phrase: 'Transcom modelers' OO cO OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO Begin notes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO C C TRANSCOM MODELERS! C C PLEASE USE THE FOLLOWING CONVENTIONS WHEN FILLING LEVEL 2 ARRAYS: C (all the array descriptions are provided below) C C PLEASE WRITE THE GRIDCELL CENTERS ("LONVECT" AND "LATVECT" VECTORS) C IN UNITS OF DEGREES EAST (ie. -175, -170.......0, 5.....170, 175) AND C DEGREES NORTH (ie. -85, 80......0, 5......80, 85) C C PLEASE ENSURE THAT THE FIRST GRIDCELL IN 2D MAPS AND 3D FIELDS IS C - AT THE DATELINE RATHER THAN AT GREENWICH C - AT THE SOUTH POLE RATHER THAN THE NORTH POLE C - AT 1000 MB RATHER THAN 100 MB (FOR 3D FIELDS) C C THESE ARRAYS WILL THEN BE WRITTEN MOVING EAST (FOR LONGITUDINAL C DIRECTION), MOVING NORTH (FOR LATITUDINAL DIRECTION) AND MOVING UP C (FOR VERTICAL DIRECTION) C C PLEASE MAINTAIN THE BASIS FUNCTION REGION NUMBERING AS INDICATED IN C THE PROTOCOL AND BASIS FUNCTION REGION MAP (ie. REGION 1 = NORTH C AMERICAN BOREAL, 2 = NORTH AMERICAN TEMPERATE......) C C UNITS: C - CO2 CONCENTRATION VALUES AS VOLUMETRIC PARTS PER MILLION (PPMV) C - SF6 CONCENTRATION VALUES AS VOLUMETRIC PARTS PER TRILLION (PPTV) C - U AND V WINDS IN METERS PER SECOND C - OMEGA WIND IN PASCALS/SECOND C C MISSING VALUES ARE REPORTED AS 1.0 x 10^36 C C LAND/SEA MASK ("LSMASK") AND TERRAIN MASK ("BETA") REPORT AS UNITLESS, C FOLLOWING THE SAME GRIDDING RULES LISTED ABOVE. C C PLEASE NOTE THAT THERE ARE FOUR TIME-SERIES TO BE C WRITTEN. THE FIRST REPRESENTS THE HIGH-FREQUENCY OUTPUT FOR THE C PRE-SUBTRACTED FIELDS. THE SECOND IS FOR THE U AND V WIND, THE THIRD C IS FOR THE TERRESTRIAL BASIS FUNCTIONS AND THE FOURTH IS FOR THE C OCEANIC BASIS FUNCTIONS. PLEASE BEGIN ALL THESE TIME SERIES AT YOUR C FIRST REPORTED TIMESTEP RATHER THAN ZERO. C C C QUESTIONS? CONTACT KEVIN - keving@atmos.colostate.edu C C To compile on Dendrus (SGI O2K) at Colorado State University: C C f90 make.output.l2.f -o make.l2 -I/usr/local/netcdf/include C -L/usr/local/lib -lnetcdf C COOOOOOOOO end notes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Program makeout cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Implicit none include 'netcdf.inc' CMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELER C C TRANSCOM MODELERS: adjust the following integer parameters!! C integer, parameter :: im=72,jm=44,pm=9, ^ timestep=6, ^ tlen1=(365+31)* ^ timestep, ^ tlen2=365*timestep*3 C CMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELER integer :: m,c,r,s,t,o,cnt integer, parameter :: mtot =12,lreg=11, ^ elapm =36, ^ statcnt=228, ^ presub =4,windnum=2 real, dimension(:), allocatable :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect,svect, ^ pvect,wvect, ^ t1vect,t2vect real, dimension(:,:), allocatable :: lsmask,svects real, dimension(:,:,:), allocatable :: ff90_s, ff90_sm1, ^ ff95_s, ff95_sm1, ^ bios_s, bios_sm1, ^ ocean_s,ocean_sm1, ^ u_s,v_s, ^ statpco2,statwind real, dimension(:,:,:,:), allocatable :: ff90,ff95,bios, ^ ocean,u,v,omega, ^ sf6_s,sf6_sm1,beta, ^ statlco2,statoco2 real, dimension(:,:,:,:,:), allocatable :: bfmap,sf6, ^ landunit,oceanunit character (len=8), dimension(:),allocatable:: monpulse character (len=1), dimension(:),allocatable:: it cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin main program variable description OOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c c im : The number of longitudinal grid cells reported. c jm : The number of latitudinal grid cells reported. c pm : The number of pressure levels reported. c timestep : The number of timesteps per day reported for the high c frequency data reporting. c tlen1 : The total number of timesteps reported for a single c year of high frequency data (timestep*(365+31)). c tlen2 : The total number of timesteps reported for three c years of high frequency data (tlen1*3). c statcnt : The number of CO2 observational stations: 228 c cnt : A counter. c mtot : The number of months in a year: 12 c lreg : The number of terrestrial basis function regions: 11 c windnum : The number of wind directions reported in the high c frequency data: 2 c elapm : The number of months written for the CO2 tracers: 36 c presub : The number of pre-subtracted tracers: 4 c monpulse : A character array containing the month-pulse names. c it : A character array containing an iteration letter. c lonvect : A vector containing the coordinates of the reported c longitudinal grid centers. First element starts near c the dateline and moves East. Units: degrees east. c latvect : A vector containing the coordinates of the reported c latitudinal grid centers. First element starts near the c South Pole. Units: degrees north. c presvect : A vector containing the coordinates of the reported c vertical grid centers in millibars. First element c starts at 1000 mb. c mvect : A vector of the month index: 1 through 12 c lvect : A vector of the region index: 1 through 11 c evect : A vector of the elapsed month index: 1 through 36 c svect : Vector of the full station index: 1-228 c svects : An array containing the three subportions of the c station index: 1-76, 77-152, 153-228 c t1vect : A vector of the single year high frequency timestep c index: 1 through 2376 c t2vect : A vector of the three year high frequency timestep c index: 1 through 2376 c pvect : A vector of the pre-subtracted tracers index: 1 thru 4 c wvect : A vector of the wind direction index: 1 through 2 c lsmask : Land/sea mask. This is a 2D array in which both c dimensions index space. c ff90 : 1990 pre-subtracted fossil-fuel CO2 mixing ratio. This c is a 4D array in which the first three dimensions index c space and the last indexes time. c ff95 : 1995 pre-subtracted fossil-fuel CO2 mixing ratio. This c is a 4D array in which the first three dimensions index c space and the last indexes time. c bios : Neutral biosphere pre-subtracted CO2 mixing ratio. This c is a 4D array in which the first three dimensions index c space and the last indexes time. c ocean : Ocean exchange pre-subtracted CO2 mixing ratio. This is c a 4D array in which the first three dimensions index c space and the last indexes time. c ff90_s : 1990 pre-subtracted fossil-fuel CO2 surface layer c mixing ratio. This is a 3D array in which the first two c dimensions index space and the last indexes time. c ff90_sm1 : 1990 pre-subtracted fossil-fuel CO2 mixing ratio in c layer above the surface layer. This is a 3D array in c which the first two dimensions index space and the last c indexes time. c ff95_s : 1995 pre-subtracted fossil-fuel CO2 surface layer c mixing ratio. This is a 3D array in which the first two c dimensions index space and the last indexes time. c ff95_sm1 : 1995 pre-subtracted fossil-fuel CO2 mixing ratio in c layer above the surface layer. This is a 3D array in c which the first two dimensions index space and the last c indexes time. c bios_s : Neutral biosphere pre-subtracted CO2 surface layer c mixing ratio. This is a 3D array in which the first two c dimensions index space and the last indexes time. c bios_sm1 : Neutral biosphere pre-subtracted CO2 mixing ratio in c layer above the surface layer. This is a 3D array in c which the first two dimensions index space and the last c indexes time. c ocean_s : Ocean exchange pre-subtracted CO2 surface layer mixing c ratio. This is a 3D array in which the first two c dimensions index space and the last indexes time. c ocean_sm1 : Ocean exchange pre-subtracted CO2 mixing ratio in layer c above the surface layer. This is a 3D array in which c the first two dimensions index space and the last time. c landunit : Terrestrial carbon 3D basis function CO2 mixing ratio. c This is a 5D array in which the first three dimensions c index space, the fourth indexes the terrestrial basis c function region, and the fifth indexes time. c oceanunit : Oceanic carbon 3D basis function CO2 mixing ratio. This c is a 5D array in which the first three dimensions index c space, the fourth indexes the oceanic basis function c region, and the fifth indexes time. c bfmap : Basis function 2D concentration maps. A 5D array c in which the first two dimensions index space, the c third indexes the basis function region, the fourth c indexes the pulse-month, and the last indexes time. c There are four types: terrestrial surface, terrestrial c layer above surface, oceanic surface, oceanic layer c above surface. c sf6 : SF6 mixing ratio. This is a 4D array in which the first c three dimensions index space, the fourth indexes the c basis function region and the last indexes time (since c this is not run as a pulsed emission, the final c dimension is 'mtot' instead of 'elapm'). c sf6_s : Surface layer SF6 mixing ratio. This is a 4D array in c which the first two dimensions index space, the third c indexes the basis function region and the last time c (since this is not run as a pulsed emission, the final c dimension is 'mtot' instead of 'elapm'). c sf6_sm1 : SF6 mixing ratio in layer above the surface layer. This c is a 4D array in which the first two dimensions index c space, the third indexes the basis function region and c the last indexes time (since this is not run as a c pulsed emission, the final dimension is 'mtot' instead c of 'elapm'). c u : Longitudinal wind velocity. This is a 4D array in which c the first three dimensions index space and the last c indexes time. c v : Latitudinal wind velocity. This is a 4D array in which c the first three dimensions index space and the last c indexes time. c omega : vertical pressure velocity. This is a 4D array in which c the first three dimensions index space and the last c indexes time. c u_s : Longitudinal surface wind velocity. This is a 3D array c in which the first two dimensions index space and the c last indexes time. c v_s : Meridional surface wind velocity. This is a 3D array in c which the first two dimensions index space and the last c indexes time. c statlco2 : A 4D array containing the CO2 single point reporting c output for the terrestrial basis function regions. The c first dimension indexes the station location, the c second indexes the basis function region, the third c indexes the pulse-month, and the last indexes time. c statoco2 : A 4D array containing the CO2 single point reporting c output for the oceanic basis function regions. The c first dimension indexes the station location, the c second indexes the basis function region, the third c indexes the pulse-month, and the last indexes time. c statpco2 : A 3D array containing the CO2 single point reporting c output for the pre-subtracted tracers. The first c dimension indexes the station location, the second c indexes the pre-subtraced tracer (order as ff90,ff95, c bios,ocean), and the last indexes time. c statwind : A 3D array containing the wind single point reporting c output. The first dimension indexes the station c location, the second indexes the reported wind c direction: u and v, and the last indexes time. c beta : Surface terrain mask. This is a 4D array in which the c first three dimensions index space and the last time. c cOOOOOOOOO end main program variable description OOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin interface module OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Interface CMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELER C C TRANSCOM MODELERS! C C IF YOU ARE CALLING A SUBROUTINE TO FILL THE OUTPUT ARRAYS, SIX C INTERFACE MODULES WILL BE REQUIRED HERE (due to the use of allocatable C arrays). C CMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELERSMODELER Subroutine write_cdf_2_1(im,jm,pm,mtot,lreg,elapm,lonvect, ^ latvect,presvect,mvect,lvect,evect, ^ ff90,ff90_s,ff90_sm1,ff95,ff95_s, ^ ff95_sm1,bios,bios_s,bios_sm1,sf6_s, ^ sf6_sm1,sf6,ocean,ocean_s,ocean_sm1, ^ u,u_s,v,v_s,omega,lsmask,beta) integer :: im,jm,pm,lreg,mtot, ^ elapm real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect real, dimension(:,:), intent(in) :: lsmask real, dimension(:,:,:), intent(in) :: ff90_s, ff95_sm1, ^ ff95_s, ff90_sm1, ^ bios_s, bios_sm1, ^ ocean_s,ocean_sm1, ^ u_s,v_s real, dimension(:,:,:,:), intent(in) :: ff90,ff95,bios, ^ ocean,u,v,omega, ^ sf6_s,sf6_sm1,beta real, dimension(:,:,:,:,:), intent(in) :: sf6 End Subroutine write_cdf_2_1 Subroutine write_cdf_2_2(mtot,lreg,statcnt,tlen1,mvect,lvect, ^ svect,t1vect,statlco2,it) integer :: mtot,lreg,statcnt, ^ tlen1 real, dimension(:), intent(in) :: mvect,lvect,svect, ^ t1vect real, dimension(:,:,:,:), intent(in) :: statlco2 character(len=1) :: it End subroutine write_cdf_2_2 Subroutine write_cdf_2_2d(statcnt,tlen2,presub,windnum,svect, ^ t2vect,pvect,wvect,statpco2,statwind) integer :: statcnt,tlen2, ^ presub,windnum real, dimension(:), intent(in) :: svect,t2vect,pvect, ^ wvect real, dimension(:,:,:), intent(in) :: statpco2,statwind End subroutine write_cdf_2_2d Subroutine write_cdf_2_3(mtot,lreg,statcnt,tlen1,mvect,lvect, ^ svect,t1vect,statoco2,it) integer :: mtot,lreg,statcnt, ^ tlen1 real, dimension(:), intent(in) :: mvect,lvect,svect, ^ t1vect real, dimension(:,:,:,:), intent(in) :: statoco2 character(len=1) :: it End subroutine write_cdf_2_3 Subroutine write_cdf_2_4(im,jm,mtot,lreg,elapm,lonvect,latvect, ^ mvect,evect,bfmap,it,cnt) integer :: im,jm,cnt, ^ mtot,lreg,elapm real, dimension(:), intent(in) :: lonvect,latvect, ^ mvect,evect real, dimension(:,:,:,:,:), intent(in) :: bfmap character(len=1) :: it End subroutine write_cdf_2_4 Subroutine write_cdf_2_5(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect, ^ evect,landunit,monpulse) integer :: m,im,jm,pm, ^ mtot,lreg, ^ elapm real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect real, dimension(:,:,:,:,:), intent(in) :: landunit character (len=8), dimension(mtot) :: monpulse End subroutine write_cdf_2_5 Subroutine write_cdf_2_6(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect, ^ evect,oceanunit,monpulse) integer :: m,im,jm,pm, ^ mtot,lreg, ^ elapm real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect real, dimension(:,:,:,:,:), intent(in) :: oceanunit character (len=8), dimension(mtot) :: monpulse End subroutine write_cdf_2_6 End interface cOOOOOOOOO end interface module OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin main program vector fill OOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Allocate(mvect (mtot )); mvect = (/(c,c=1,mtot) /) Allocate(lvect (lreg )); lvect = (/(c,c=1,lreg) /) Allocate(evect (elapm )); evect = (/(c,c=1,elapm) /) Allocate(svect(statcnt)) svect = (/(c,c=1,statcnt)/) Allocate(svects(3,statcnt/3)) svects(1,:) = (/(c,c=1,statcnt/3)/) svects(2,:) = (/(c,c=statcnt/3+1,2*statcnt/3)/) svects(3,:) = (/(c,c=2*statcnt/3+1,statcnt)/) Allocate(it(4)) it(1) = 'a' it(2) = 'b' it(3) = 'c' it(4) = 'd' Allocate(t1vect(tlen1 )); t1vect = (/(c,c=1,tlen1) /) Allocate(t2vect(tlen2 )); t2vect = (/(c,c=1,tlen2) /) Allocate(pvect (presub )); pvect = (/(c,c=1,presub) /) Allocate(wvect (windnum)); wvect = (/(c,c=1,windnum)/) Allocate(monpulse(mtot)) monpulse(1) = 'janpulse'; monpulse(2) = 'febpulse' monpulse(3) = 'marpulse'; monpulse(4) = 'aprpulse' monpulse(5) = 'maypulse'; monpulse(6) = 'junpulse' monpulse(7) = 'julpulse'; monpulse(8) = 'augpulse' monpulse(9) = 'seppulse'; monpulse(10) = 'octpulse' monpulse(11) = 'novpulse'; monpulse(12) = 'decpulse' cOOOOOOOOO end main program vector fill OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_1 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Allocate(lonvect (im)) Allocate(latvect (jm)) Allocate(presvect (pm)) Allocate(lsmask (im,jm)) Allocate(ff90_s (im,jm,elapm)) Allocate(ff90_sm1 (im,jm,elapm)) Allocate(ff95_s (im,jm,elapm)) Allocate(ff95_sm1 (im,jm,elapm)) Allocate(bios_s (im,jm,elapm)) Allocate(bios_sm1 (im,jm,elapm)) Allocate(ocean_s (im,jm,elapm)) Allocate(ocean_sm1(im,jm,elapm)) Allocate(u_s (im,jm,elapm)) Allocate(v_s (im,jm,elapm)) Allocate(ff90 (im,jm,pm,elapm)) Allocate(ff95 (im,jm,pm,elapm)) Allocate(bios (im,jm,pm,elapm)) Allocate(ocean (im,jm,pm,elapm)) Allocate(u (im,jm,pm,elapm)) Allocate(v (im,jm,pm,elapm)) Allocate(omega (im,jm,pm,elapm)) Allocate(beta (im,jm,pm,elapm)) Allocate(sf6_s (im,jm,lreg,mtot)) Allocate(sf6_sm1 (im,jm,lreg,mtot)) Allocate(sf6 (im,jm,pm,lreg,mtot)) C TRANSCOM MODELERS! C C FILL THE JUST-ALLOCATED ARRAYS HERE. THIS CAN BE DONE WITH EITHER A C SUBROUTINE CALL (which requires code in the interface module above) OR C PERFORMED DIRECTLY IN THIS PORTION OF THE PROGRAM'S MAIN BODY (no C interface module required). C cOOOOOOOOO end allocation and 2_1 array filling OOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_1 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the first netCDF writing subroutine' Write(*,*) ' ' Call write_cdf_2_1(im,jm,pm,mtot,lreg,elapm,lonvect, ^ latvect,presvect,mvect,lvect,evect, ^ ff90,ff90_s,ff90_sm1,ff95,ff95_s,ff95_sm1, ^ bios,bios_s,bios_sm1,sf6_s,sf6_sm1,sf6, ^ ocean,ocean_s,ocean_sm1,u,u_s,v,v_s,omega, ^ lsmask,beta) Write(*,*) 'output.L2.1.nc written and closed' Write(*,*) ' ' Deallocate(ff90,ff90_s,ff90_sm1,ff95,ff95_s,ff95_sm1,bios,bios_s) Deallocate(bios_sm1,ocean,ocean_s,ocean_sm1,sf6_s,sf6_sm1,sf6) Deallocate(u,u_s,v,v_s,omega,lsmask,beta) cOOOOOOOOO end call to write_cdf_2_1 subroutine and deallocate OOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_2 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Do o = 1, 3 Allocate(statlco2(statcnt/3,lreg,mtot,tlen1)) C TRANSCOM MODELERS! C C FILL THE THREE PORTIONS OF THE STATLCO2 ARRAY HERE; A THIRD EACH TIME C THROUGH THIS O-LOOP. THEY ARE DIVIDED INTO EQUAL THIRDS BY THE C STATION DIMENSION AND SHOULD BE FILLED IN THE FOLLOWING ORDER: C C 1) STATIONS 1-76, C 2) STATIONS 77-152, C 3) STATIONS 153-228. C C THIS ARRAY FILLING CAN BE DONE WITH EITHER A SUBROUTINE CALL (which C requires code in the interface module above)OR PERFORMED DIRECTLY IN C THIS PORTION OF THE PROGRAM'S MAIN BODY (no interface module C required). C cOOOOOOOOO end allocation and array filling OOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_2 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the netCDF writing subroutine 2_2'//it(o) Write(*,*) ' ' Call write_cdf_2_2(mtot,lreg,statcnt/3,tlen1,mvect,lvect, ^ svects(o,:),t1vect,statlco2,it(o)) Write(*,*) 'output.L2.2'//it(o)//'.nc written and closed' Write(*,*) ' ' Deallocate(statlco2) End do cOOOOOOOOO end call to write_cdf_2_2 subroutine and deallocate OOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_2d array filling OOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Allocate(statpco2(statcnt,presub, tlen2)) Allocate(statwind(statcnt,windnum,tlen2)) C TRANSCOM MODELERS! C C FILL THE JUST-ALLOCATED ARRAYS HERE. THIS CAN BE DONE WITH EITHER A C SUBROUTINE CALL (which requires code in the interface module above) OR C PERFORMED DIRECTLY IN THIS PORTION OF THE PROGRAM'S MAIN BODY (no C interface module required). C cOOOOOOOOO end allocation and array filling OOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_2d subroutine and deallocate OOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the netCDF writing subroutine 2_2d' Write(*,*) ' ' Call write_cdf_2_2d(statcnt,tlen2,presub,windnum, ^ svect,t2vect,pvect,wvect,statpco2,statwind) Write(*,*) 'output.L2.2d.nc written and closed' Write(*,*) ' ' Deallocate(statpco2,statwind) cOOOOOOOOO end call to write_cdf_2_2d subroutine and deallocate OOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_3 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Do o = 1, 3 Allocate(statoco2(statcnt/3,lreg,mtot,tlen1)) C TRANSCOM MODELERS! C C FILL THE THREE PORTIONS OF THE STATOCO2 ARRAY HERE; A THIRD EACH TIME C THROUGH THIS O-LOOP. THEY ARE DIVIDED INTO EQUAL THIRDS BY THE C STATION DIMENSION AS AND SHOULD BE FILLED IN THE FOLLOWING ORDER: C C 1) STATIONS 1-76, C 2) STATIONS 77-152, C 3) STATIONS 153-228 C C THIS ARRAY FILLING CAN BE DONE WITH EITHER A SUBROUTINE CALL (which C requires code in the interface module above)OR PERFORMED DIRECTLY IN C THIS PORTION OF THE PROGRAM'S MAIN BODY (no interface module C required). C cOOOOOOOOO end allocation and 2_3 array filling OOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_3 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the netCDF writing subroutine 2_3'//it(o) Write(*,*) ' ' Call write_cdf_2_3(mtot,lreg,statcnt/3,tlen1,mvect,lvect, ^ svects(o,:),t1vect,statoco2,it(o)) Write(*,*) 'output.L2.3'//it(o)//'.nc written and closed' Write(*,*) ' ' Deallocate(statoco2) End do cOOOOOOOOO end call to write_cdf_2_3 subroutine and deallocate OOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_4 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cnt = 0 Do o = 1, 4 Allocate(bfmap(im,jm,lreg,mtot,elapm)) cnt = cnt + 1 C TRANSCOM MODELERS! C C FILL THE JUST-ALLOCATED ARRAY HERE. THIS IS DONE FOUR TIMES, ONCE EACH C TIME THROUGH THIS O-LOOP. THIS ARRAY HOLDS THE BASIS FUNCTION MAP C FIELDS AND SHOULD BE FILLED IN THE FOLLOWING ORDER: C C 1) TERRESTRIAL BASIS FUNCTION SURFACE CONCENTRATION, C 2) TERRESTRIAL BASIS FUNCTION CONCENTRATION ABOVE THE SURFACE LAYER, C 3) OCEANIC BASIS FUNCTION SURFACE CONCENTRATION, C 4) OCEANIC BASIS FUNCTION CONCENTRATION ABOVE THE SURFACE LAYER. C C THIS ARRAY FILLING CAN BE DONE WITH EITHER A SUBROUTINE CALL (which C requires code in the interface module above) OR PERFORMED DIRECTLY C IN THIS PORTION OF THE PROGRAM'S MAIN BODY (no interface module C required). C cOOOOOOOOO end allocation and 2_4 array filling OOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_4 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the netCDF writing subroutine 2.4'//it(o) Write(*,*) ' ' Call write_cdf_2_4(im,jm,mtot,lreg,elapm,lonvect,latvect, ^ mvect,evect,bfmap,it(o),cnt) Write(*,*) 'output.L2.4'//it(o)//'.nc written' Write(*,*) ' ' Deallocate(bfmap) End do cOOOOOOOOO end call to write_cdf_2_4 subroutine and deallocate OOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_5 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Allocate(landunit(im,jm,pm,lreg,elapm)) Do m = 1, mtot C TRANSCOM MODELERS! C C FILL THE JUST-ALLOCATED ARRAYS HERE. THIS CAN BE DONE WITH EITHER A C SUBROUTINE CALL (which requires code in the interface module above) OR C PERFORMED DIRECTLY IN THIS PORTION OF THE PROGRAM'S MAIN BODY (no C interface module required). NOTE THAT THIS IS DONE WITHIN A LOOP C THROUGH "MTOT" (THE VALUE IS 12). SO, THE LANDUNIT ARRAY IS FILLED C ONCE FOR EVERY MONTH-PULSE. C cOOOOOOOOO end allocation and array 2_5 filling OOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_5 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the fifth netCDF writing subroutine' Write(*,*) ' ' Call write_cdf_2_5(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect,evect, ^ landunit,monpulse) Write(*,*) 'output.L2.5_'//monpulse(m)//'.nc written, closed' Write(*,*) ' ' End do Write(*,*) ' ' Deallocate(landunit) cOOOOOOOOO end call to write_cdf_5 subroutine and deallocate OOOOOOOOOOO cXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin allocation and 2_6 array filling OOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Allocate(oceanunit(im,jm,pm,lreg,elapm)) Do m = 1, mtot C TRANSCOM MODELERS! C C FILL THE JUST-ALLOCATED ARRAYS HERE. THIS CAN BE DONE WITH EITHER A C SUBROUTINE CALL (which requires code in the interface module above) OR C PERFORMED DIRECTLY IN THIS PORTION OF THE PROGRAM'S MAIN BODY (no C interface module required). NOTE THAT THIS IS DONE WITHIN A LOOP C THROUGH "MTOT" (THE VALUE IS 12). SO, THE LANDUNIT ARRAY IS FILLED C ONCE FOR EVERY MONTH-PULSE. C cOOOOOOOOO end allocation and 2_6 array filling OOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin call to write_cdf_2_6 subroutine and deallocate OOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Write(*,*) 'Calling the sixth netCDF writing subroutine' Write(*,*) ' ' Call write_cdf_2_6(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect,evect, ^ oceanunit,monpulse) Write(*,*) 'output.L2.6_'//monpulse(m)//'.nc written, closed' Write(*,*) ' ' End do Write(*,*) ' ' Deallocate(oceanunit) cOOOOOOOOO end call to write_cdf_6 subroutine and deallocate OOOOOOOOOOO Stop End Program makeout cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_1 SUBROUTINE OO cO OO cO This subroutine writes the non-regional TransCom 3 level 2 output OO cO to a netcdf file called "output.L2.1.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_1(im,jm,pm,mtot,lreg,elapm,lonvect, ^ latvect,presvect,mvect,lvect,evect, ^ ff90,ff90_s,ff90_sm1,ff95,ff95_s,ff95_sm1, ^ bios,bios_s,bios_sm1,sf6_s,sf6_sm1,sf6, ^ ocean,ocean_s,ocean_sm1,u,u_s,v,v_s,omega, ^ lsmask,beta) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: im,jm,pm,mtot,lreg, ^ elapm,r real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect,lvect, ^ evect real, dimension(:,:), intent(in) :: lsmask real, dimension(:,:,:), intent(in) :: ff90_s, ff90_sm1, ^ ff95_s, ff95_sm1, ^ bios_s, bios_sm1, ^ ocean_s,ocean_sm1, ^ u_s,v_s real, dimension(:,:,:,:), intent(in) :: ff90,ff95,bios,ocean, ^ u,v,omega, ^ sf6_s,sf6_sm1,beta real, dimension(:,:,:,:,:), intent(in) :: sf6 character (len=80) :: regn character (len=2), dimension(lreg) :: num character (len=10), dimension(lreg) :: sf6name cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,imid, ^ jmid,pmid,mtotid, ^ lregid,elapmid,lonid, ^ latid,presid,mid,lid, ^ tid,ff90id,ff90_sid, ^ ff90_sm1id,ff95id, ^ ff95_sid,ff95_sm1id, ^ biosid,bios_sid, ^ bios_sm1id,oceanid, ^ ocean_sid, ^ ocean_sm1id,sf6_sid, ^ sf6_sm1id, ^ sf6_regid(lreg), ^ uid,vid, ^ u_sid,v_sid,omegaid, ^ lsmaskid,betaid, ^ vdims2(2),vdims3(3), ^ vdims4(4), ^ start2(2),count2(2), ^ start3(3),count3(3), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c r : An index for looping over the terrestrial regions. c sf6name : A character array containing the variable names for c the series of netCDF arrays associated with the SF6 c basis function region 3D concentrations. c regn : A character variable used for the 'long_name' netCDF c attribute. c num : A character array containing the basis function region c number: 01 through 11. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c sf6_reg# : These ID's reduce the incoming sf6 5D array c into 4D arrays. There are 11 of these ID's, one c one for each terrestrial basis function region. c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO sf6name(1) = 'sf6_reg_01'; num(1) = '01' sf6name(2) = 'sf6_reg_02'; num(2) = '02' sf6name(3) = 'sf6_reg_03'; num(3) = '03' sf6name(4) = 'sf6_reg_04'; num(4) = '04' sf6name(5) = 'sf6_reg_05'; num(5) = '05' sf6name(6) = 'sf6_reg_06'; num(6) = '06' sf6name(7) = 'sf6_reg_07'; num(7) = '07' sf6name(8) = 'sf6_reg_08'; num(8) = '08' sf6name(9) = 'sf6_reg_09'; num(9) = '09' sf6name(10) = 'sf6_reg_10'; num(10) = '10' sf6name(11) = 'sf6_reg_11'; num(11) = '11' cOOOOOOOOO end variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.1.nc',0,ncid) write(*,*) 'output.L2.1.nc created' write(*,*) ' ' status = NF_DEF_DIM(ncid,'longitude',im,imid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'latitude',jm,jmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'height',pm,pmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'month',mtot,mtotid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'land_region',lreg,lregid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'time',elapm,elapmid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time,regions) cccccccccc status = NF_DEF_VAR(ncid,'longitude',NF_FLOAT,1,imid,lonid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'latitude',NF_FLOAT,1,jmid,latid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'height',NF_FLOAT,1,pmid,presid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'month',NF_FLOAT,1,mtotid,mid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'land_region',NF_FLOAT,1,lregid,lid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'time',NF_FLOAT,1,elapmid,tid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc land/ocean mask (lsmask) cccccccccccccccccccccccccccccccccccc vdims2(1) = imid; vdims2(2) = jmid status = NF_DEF_VAR(ncid,'lsmask',NF_FLOAT,2,vdims2,lsmaskid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted carbon surface maps cccccccccccccccccccccccccc c ff90_s,ff90_sm1,ff95_s,ff95_sm1,bios_s,bios_sm1,ocean_s,ocean_sm1 vdims3(1) = imid; vdims3(2) = jmid; vdims3(3) = elapmid status = NF_DEF_VAR(ncid,'ff90_s',NF_FLOAT,3,vdims3,ff90_sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ff90_sm1',NF_FLOAT,3,vdims3,ff90_sm1id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ff95_s',NF_FLOAT,3,vdims3,ff95_sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ff95_sm1',NF_FLOAT,3,vdims3,ff95_sm1id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'bios_s',NF_FLOAT,3,vdims3,bios_sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'bios_sm1',NF_FLOAT,3,vdims3,bios_sm1id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ocean_s',NF_FLOAT,3,vdims3,ocean_sid) if (status .ne. nf_noerr) call handle_err(status) status =NF_DEF_VAR(ncid,'ocean_sm1',NF_FLOAT,3,vdims3,ocean_sm1id) if (status .ne. nf_noerr) call handle_err(status) cccccccccc surface wind maps (u_s,v_s) ccccccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'u_s',NF_FLOAT,3,vdims3,u_sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'v_s',NF_FLOAT,3,vdims3,v_sid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted 3D carbon fields (ff90,ff95,bios,ocean) cccccc vdims4(1)=imid; vdims4(2)=jmid; vdims4(3)=pmid; vdims4(4)=elapmid status = NF_DEF_VAR(ncid,'ff90',NF_FLOAT,4,vdims4,ff90id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ff95',NF_FLOAT,4,vdims4,ff95id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'bios',NF_FLOAT,4,vdims4,biosid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'ocean',NF_FLOAT,4,vdims4,oceanid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D wind fields (u,v,omega) cccccccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'u',NF_FLOAT,4,vdims4,uid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'v',NF_FLOAT,4,vdims4,vid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'omega',NF_FLOAT,4,vdims4,omegaid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc terrain mask (beta) ccccccccccccccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'beta',NF_FLOAT,4,vdims4,betaid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D SF6 fields (sf6_reg1,sf6_reg2......) ccccccccccccccccccccc vdims4(1)=imid; vdims4(2)=jmid; vdims4(3)=pmid; vdims4(4)=mtotid Do r = 1, lreg status = NF_DEF_VAR(ncid,sf6name(r),NF_FLOAT,4,vdims4, ^ sf6_regid(r)) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc SF6 surface maps (sf6_s,sf6_sm1) cccccccccccccccccccccccccccc vdims4(1)=imid; vdims4(2)=jmid; vdims4(3)=lregid; vdims4(4)=mtotid status = NF_DEF_VAR(ncid,'sf6_s',NF_FLOAT,4,vdims4,sf6_sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'sf6_sm1',NF_FLOAT,4,vdims4,sf6_sm1id) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time,regions) cccccccccc status = NF_PUT_ATT_TEXT(ncid,lonid,'long_name',29, ^ 'Longitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lonid,'units',12,'degrees_east') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'long_name',28, ^ 'Latitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'units',13,'degrees_north') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'long_name',25, ^ 'Vertical gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'units',9,'millibars') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'long_name',5,'month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'units',5,'month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'long_name',13,'region number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'units',11,'land region') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'long_name',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'units',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) cccccccccc land/ocean mask (lsmask) cccccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,lsmaskid,'long_name',13, ^ 'Land/sea mask') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lsmaskid,'units',8,'unitless') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,lsmaskid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted carbon surface maps cccccccccccccccccccccccccc c ff90_s,ff90_sm1,ff95_s,ff95_sm1,bios_s,bios_sm1,ocean_s,ocean_sm1 status = NF_PUT_ATT_TEXT(ncid,ff90_sid,'long_name',47, ^ 'Pre-subtracted 1990 fossil fuel CO2 surface map') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff90_sid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff90_sid,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95_sid,'long_name',47, ^ 'Pre-subtracted 1995 fossil fuel CO2 surface map') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95_sid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff95_sid,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,bios_sid,'long_name',40, ^ 'Pre-subtracted biosphere CO2 surface map') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,bios_sid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,bios_sid,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ocean_sid,'long_name',38, ^ 'Pre-subtracted oceanic CO2 surface map') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ocean_sid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ocean_sid,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff90_sm1id,'long_name',60, ^ 'Pre-subtracted 1990 fossil fuel CO2 map: layer above surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff90_sm1id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff90_sm1id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95_sm1id,'long_name',60, ^ 'Pre-subtracted 1995 fossil fuel CO2 map: layer above surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95_sm1id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff95_sm1id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,bios_sm1id,'long_name',53, ^ 'Pre-subtracted biosphere CO2 map: layer above surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,bios_sm1id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,bios_sm1id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ocean_sm1id,'long_name',51, ^ 'Pre-subtracted oceanic CO2 map: layer above surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ocean_sm1id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status =NF_PUT_ATT_REAL(ncid,ocean_sm1id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc surface wind maps (u_s,v_s)cccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,u_sid,'long_name',34, ^ 'Longitudinal surface wind velocity') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,u_sid,'units',17, ^ 'meters per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,u_sid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,v_sid,'long_name',32, ^ 'Meridional surface wind velocity') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,v_sid,'units',17, ^ 'meters per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,v_sid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted 3D carbon fields (ff90,ff95,bios,ocean) cccccc status = NF_PUT_ATT_TEXT(ncid,ff90id,'long_name',44, ^ 'Pre-subtracted 1990 fossil fuel CO2 3D field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff90id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff90id,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95id,'long_name',44, ^ 'Pre-subtracted 1995 fossil fuel CO2 3D field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,ff95id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,ff95id,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,biosid,'long_name',37, ^ 'Pre-subtracted biosphere CO2 3D field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,biosid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,biosid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,oceanid,'long_name',35, ^ 'Pre-subtracted oceanic CO2 3D field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,oceanid,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,oceanid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D wind fields (u,v,omega) cccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,uid,'long_name',26, ^ 'Longitudinal 3D wind field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,uid,'units',17, ^ 'meters per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,uid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,vid,'long_name',24, ^ 'Meridional 3D wind field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,vid,'units',17, ^ 'meters per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,vid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,omegaid,'long_name',22, ^ 'Vertical 3D wind field') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,omegaid,'units',18, ^ 'pascals per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,omegaid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc terrain mask (beta) ccccccccccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,betaid,'long_name',20, ^ 'Surface terrain mask') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,betaid,'units',8,'unitless') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,betaid,'missing_value',NF_FLOAT,1, ^ misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D SF6 fields (sf6_reg1,sf6_reg2,sf6_reg3.......) ccccccccccc Do r = 1, lreg regn = 'SF6 basis function 3D concentration field: terrestrial ^region '//num(r) status = NF_PUT_ATT_TEXT(ncid,sf6_regid(r),'long_name',64,regn) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sf6_regid(r),'units',4,'pptv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,sf6_regid(r),'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc SF6 surface maps (sf6_s,sf6_sm1) cccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,sf6_sid,'long_name',30, ^ 'SF6 concentration map: surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sf6_sid,'units',4,'pptv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,sf6_sid,'missing_value',NF_FLOAT, ^ 1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sf6_sm1id,'long_name',42, ^ 'SF6 concentration map: layer above surface') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sf6_sm1id,'units',4,'pptv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,sf6_sm1id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time,regions) cccccccccc status = NF_PUT_VAR_REAL(ncid,lonid,lonvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,latid,latvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,presid,presvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,mid,mvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,lid,lvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,tid,evect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc land/ocean mask (lsmask) cccccccccccccccccccccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,lsmaskid,lsmask) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted carbon surface maps cccccccccccccccccccccccccc c ff90_s,ff90_sm1,ff95_s,ff95_sm1,bios_s,bios_sm1,ocean_s,ocean_sm1 start3(1) = 1; start3(2) = 1; start3(3) = 1 count3(1) = im; count3(2) = jm; count3(3) = elapm status = NF_PUT_VARA_REAL(ncid,ff90_sid,start3,count3,ff90_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ff95_sid,start3,count3,ff95_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,bios_sid,start3,count3,bios_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ocean_sid,start3,count3,ocean_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ff90_sm1id,start3,count3,ff90_sm1) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ff95_sm1id,start3,count3,ff95_sm1) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,bios_sm1id,start3,count3,bios_sm1) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ocean_sm1id,start3,count3, ^ ocean_sm1) if (status .ne. nf_noerr) call handle_err(status) cccccccccc surface wind maps (u_s,v_s)cccccccccccccccccccccccccccccccccc status = NF_PUT_VARA_REAL(ncid,u_sid,start3,count3,u_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,v_sid,start3,count3,v_s) if (status .ne. nf_noerr) call handle_err(status) cccccccccc pre-subtracted 3D carbon fields (ff90,ff95,bios,ocean) cccccc start4(1) = 1; start4(2) = 1; start4(3) = 1; start4(4) = 1 count4(1) = im; count4(2) = jm; count4(3) = pm; count4(4) = elapm status = NF_PUT_VARA_REAL(ncid,ff90id,start4,count4,ff90) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,ff95id,start4,count4,ff95) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,biosid,start4,count4,bios) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,oceanid,start4,count4,ocean) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D wind fields (u,v,omega) cccccccccccccccccccccccccccccccccc status = NF_PUT_VARA_REAL(ncid,uid,start4,count4,u) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,vid,start4,count4,v) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,omegaid,start4,count4,omega) if (status .ne. nf_noerr) call handle_err(status) cccccccccc terrain mask (beta) ccccccccccccccccccccccccccccccccccccccccc status = NF_PUT_VARA_REAL(ncid,betaid,start4,count4,beta) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D SF6 fields (sf6_reg1,sf6_reg2,sf6_reg3.......) ccccccccccc count4(1) = im; count4(2) = jm; count4(3) = pm; count4(4) = mtot Do r = 1, lreg status=NF_PUT_VARA_REAL(ncid,sf6_regid(r),start4,count4, ^ sf6(:,:,:,r,:)) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc SF6 surface maps (sf6_s,sf6_sm1) cccccccccccccccccccccccccccc count4(3) = lreg status = NF_PUT_VARA_REAL(ncid,sf6_sid,start4,count4,sf6_s) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VARA_REAL(ncid,sf6_sm1id,start4,count4,sf6_sm1) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_2X SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.2X.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_2(mtot,lreg,statcnt,tlen1, ^ mvect,lvect,svect,t1vect,statlco2,it) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: mtot,lreg,statcnt, ^ tlen1 real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: mvect,lvect,svect, ^ t1vect real, dimension(:,:,:,:), intent(in) :: statlco2 character(len=1) :: it cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,mtotid, ^ lregid,statcntid, ^ tlen1id, ^ mid,lid,sid,t1id, ^ statlco2id, ^ vdims3(3),vdims4(4), ^ start3(3),count3(3), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.2'//it//'.nc',0,ncid) write(*,*) 'output.L2.2'//it//'.nc created' status = NF_DEF_DIM(ncid,'month',mtot,mtotid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'land_region',lreg,lregid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'station_count',statcnt,statcntid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'tlen1',tlen1,tlen1id) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'month',NF_FLOAT,1,mtotid,mid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'land_region',NF_FLOAT,1,lregid,lid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'station_count',NF_FLOAT,1,statcntid,sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'tlen1',NF_FLOAT,1,tlen1id,t1id) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statlco2X) ccccccccccccccccccccccccccccccccccccc vdims4(1) = statcntid; vdims4(2) = lregid; vdims4(3) = mtotid vdims4(4) = tlen1id status =NF_DEF_VAR(ncid,'stat_L_CO2'//it,NF_FLOAT,4,vdims4, ^ statlco2id) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,mid,'long_name',5,'month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'units',11,'pulse-month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'long_name',13,'region number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'units',11,'land region') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sid,'long_name',14,'station number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sid,'units',7,'station') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t1id,'long_name',34, ^ 'elapsed timesteps in one year span') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t1id,'units',8,'timestep') if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statlco2X) ccccccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,statlco2id,'long_name',58, ^ 'High frequency land basis function station CO2 time series') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,statlco2id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,statlco2id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,mid,mvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,lid,lvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,sid,svect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,t1id,t1vect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statlco2X) ccccccccccccccccccccccccccccccccccccc start4(1) = 1; start4(2) = 1; start4(3) = 1; start4(4) = 1 count4(1)=statcnt;count4(2)=lreg;count4(3)=mtot;count4(4)=tlen1 status = NF_PUT_VARA_REAL(ncid,statlco2id,start4,count4,statlco2) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_2d SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.2d.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_2d(statcnt,tlen2,presub,windnum,svect, ^ t2vect,pvect,wvect,statpco2,statwind) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: statcnt,tlen2, ^ presub,windnum real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: svect,t2vect,pvect, ^ wvect real, dimension(:,:,:), intent(in) :: statpco2,statwind cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid, ^ statcntid, ^ tlen2id, ^ presubid,windnumid, ^ sid, ^ t2id,pid,wid, ^ statpco2id, ^ statwindid, ^ vdims3(3),vdims4(4), ^ start3(3),count3(3), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.2d.nc',0,ncid) write(*,*) 'output.L2.2d.nc created' status = NF_DEF_DIM(ncid,'station_count',statcnt,statcntid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'tlen2',tlen2,tlen2id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'presub_number',presub,presubid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'wind_dir',windnum,windnumid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'station_count',NF_FLOAT,1,statcntid,sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'tlen2',NF_FLOAT,1,tlen2id,t2id) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'presub_number',NF_FLOAT,1,presubid,pid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'wind_dir',NF_FLOAT,1,windnumid,wid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statpco2,statwind) ccccccccccccccccccccccccccccc vdims3(1) = statcntid; vdims3(2) = presubid; vdims3(3) = tlen2id status =NF_DEF_VAR(ncid,'stat_p_CO2',NF_FLOAT,3,vdims3,statpco2id) if (status .ne. nf_noerr) call handle_err(status) vdims3(1) = statcntid; vdims3(2) = windnumid; vdims3(3) = tlen2id status = NF_DEF_VAR(ncid,'stat_wind',NF_FLOAT,3,vdims3,statwindid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,sid,'long_name',14,'station number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sid,'units',7,'station') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t2id,'long_name',35, ^ 'elapsed timesteps in four year span') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t2id,'units',8,'timestep') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,pid,'long_name',13,'tracer number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,pid,'units',14,'pre-sub tracer') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,wid,'long_name',21, ^ 'wind direction number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,wid,'units',14,'wind direction') if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statpco2,statwind) ccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,statpco2id,'long_name',53, ^ 'High frequency pre-subtracted station CO2 time series') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,statpco2id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,statpco2id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,statwindid,'long_name',39, ^ 'High frequency station wind time series') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,statwindid,'units',17, ^ 'meters per second') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,statwindid,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,sid,svect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,t2id,t2vect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,pid,pvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,wid,wvect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statpco2,statwind) ccccccccccccccccccccccccccccc start3(1) = 1; start3(2) = 1; start3(3) = 1 count3(1) = statcnt; count3(2) = presub; count3(3) = tlen2 status = NF_PUT_VARA_REAL(ncid,statpco2id,start3,count3,statpco2) if (status .ne. nf_noerr) call handle_err(status) count3(1) = statcnt; count3(2) = windnum; count3(3) = tlen2 status = NF_PUT_VARA_REAL(ncid,statwindid,start3,count3,statwind) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_2d !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_3X SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.3X.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_3(mtot,lreg,statcnt,tlen1, ^ mvect,lvect,svect,t1vect,statoco2,it) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: mtot,lreg,statcnt, ^ tlen1 real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: mvect,lvect,svect, ^ t1vect real, dimension(:,:,:,:), intent(in) :: statoco2 character(len=1) :: it cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,mtotid, ^ lregid,statcntid, ^ tlen1id, ^ mid,lid,sid,t1id, ^ statoco2id, ^ vdims4(4), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.3'//it//'.nc',0,ncid) write(*,*) 'output.L2.3'//it//'.nc created' status = NF_DEF_DIM(ncid,'month',mtot,mtotid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'land_region',lreg,lregid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'station_count',statcnt,statcntid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'tlen1',tlen1,tlen1id) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_DEF_VAR(ncid,'month',NF_FLOAT,1,mtotid,mid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'land_region',NF_FLOAT,1,lregid,lid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'station_count',NF_FLOAT,1,statcntid,sid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'tlen1',NF_FLOAT,1,tlen1id,t1id) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statoco2) cccccccccccccccccccccccccccccccccccccc vdims4(1) = statcntid; vdims4(2) = lregid; vdims4(3) = mtotid vdims4(4) = tlen1id status =NF_DEF_VAR(ncid,'stat_O_CO2'//it,NF_FLOAT,4,vdims4, ^ statoco2id) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,mid,'long_name',5,'month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'units',11,'pulse-month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'long_name',13,'region number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lid,'units',12,'ocean region') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sid,'long_name',14,'station number') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,sid,'units',7,'station') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t1id,'long_name',34, ^ 'elapsed timesteps in one year span') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,t1id,'units',8,'timestep') if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statoco2X) ccccccccccccccccccccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,statoco2id,'long_name',61, ^ 'High frequency oceanic basis function station CO2 time series') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,statoco2id,'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,statoco2id,'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (regions,time,numbers) cccccccccccccccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,mid,mvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,lid,lvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,sid,svect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,t1id,t1vect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc time series (statoco2X) ccccccccccccccccccccccccccccccccccccc start4(1) = 1; start4(2) = 1; start4(3) = 1; start4(4) = 1 count4(1)=statcnt;count4(2)=lreg;count4(3)=mtot;count4(4)=tlen1 status = NF_PUT_VARA_REAL(ncid,statoco2id,start4,count4, ^ statoco2) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_4X SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.4X.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_4(im,jm,mtot,lreg,elapm,lonvect,latvect, ^ mvect,evect,bfmap,it,cnt) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: im,jm,r,cnt, ^ mtot,lreg,elapm real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: lonvect,latvect, ^ mvect,evect real, dimension(:,:,:,:,:), intent(in) :: bfmap character (len=80) :: regn character (len=2), dimension(lreg) :: num character (len=20), dimension(lreg,4) :: bfname character (len=1) :: it cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,imid,jmid, ^ mtotid,elapmid, ^ lonid,latid,mid,tid, ^ bfmapid(lreg), ^ vdims4(4), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c r : Loop index. Loops over lreg. c regn : A character variable used for the 'long_name' netCDF c attribute. c num : A character array containing the basis function region c number: 01 through 11. c bfname : A character array containing the variable names for c the series of netCDF arrays associated with the 2D CO2 c basis function region concentrations: terrestrial c surface, terrestrial layer above surface, oceanic c surface, oceanic layer above surface. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO bfname(1,1) = 'landunit_s_reg_01'; num(1) = '01' bfname(2,1) = 'landunit_s_reg_02'; num(2) = '02' bfname(3,1) = 'landunit_s_reg_03'; num(3) = '03' bfname(4,1) = 'landunit_s_reg_04'; num(4) = '04' bfname(5,1) = 'landunit_s_reg_05'; num(5) = '05' bfname(6,1) = 'landunit_s_reg_06'; num(6) = '06' bfname(7,1) = 'landunit_s_reg_07'; num(7) = '07' bfname(8,1) = 'landunit_s_reg_08'; num(8) = '08' bfname(9,1) = 'landunit_s_reg_09'; num(9) = '09' bfname(10,1) = 'landunit_s_reg_10'; num(10) = '10' bfname(11,1) = 'landunit_s_reg_11'; num(11) = '11' bfname(1,2) = 'landunit_sm1_reg_01' bfname(2,2) = 'landunit_sm1_reg_02' bfname(3,2) = 'landunit_sm1_reg_03' bfname(4,2) = 'landunit_sm1_reg_04' bfname(5,2) = 'landunit_sm1_reg_05' bfname(6,2) = 'landunit_sm1_reg_06' bfname(7,2) = 'landunit_sm1_reg_07' bfname(8,2) = 'landunit_sm1_reg_08' bfname(9,2) = 'landunit_sm1_reg_09' bfname(10,2) = 'landunit_sm1_reg_10' bfname(11,2) = 'landunit_sm1_reg_11' bfname(1,3) = 'oceanunit_s_reg_01' bfname(2,3) = 'oceanunit_s_reg_02' bfname(3,3) = 'oceanunit_s_reg_03' bfname(4,3) = 'oceanunit_s_reg_04' bfname(5,3) = 'oceanunit_s_reg_05' bfname(6,3) = 'oceanunit_s_reg_06' bfname(7,3) = 'oceanunit_s_reg_07' bfname(8,3) = 'oceanunit_s_reg_08' bfname(9,3) = 'oceanunit_s_reg_09' bfname(10,3) = 'oceanunit_s_reg_10' bfname(11,3) = 'oceanunit_s_reg_11' bfname(1,4) = 'oceanunit_sm1_reg_01' bfname(2,4) = 'oceanunit_sm1_reg_02' bfname(3,4) = 'oceanunit_sm1_reg_03' bfname(4,4) = 'oceanunit_sm1_reg_04' bfname(5,4) = 'oceanunit_sm1_reg_05' bfname(6,4) = 'oceanunit_sm1_reg_06' bfname(7,4) = 'oceanunit_sm1_reg_07' bfname(8,4) = 'oceanunit_sm1_reg_08' bfname(9,4) = 'oceanunit_sm1_reg_09' bfname(10,4) = 'oceanunit_sm1_reg_10' bfname(11,4) = 'oceanunit_sm1_reg_11' cOOOOOOOOO end variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.4'//it//'.nc',0,ncid) write(*,*) 'output.L2.4'//it//'.nc created' status = NF_DEF_DIM(ncid,'longitude',im,imid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'latitude',jm,jmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'pulse',mtot,mtotid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'time',elapm,elapmid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,regions,time) ccccccccccccccccccc status = NF_DEF_VAR(ncid,'longitude',NF_FLOAT,1,imid,lonid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'latitude',NF_FLOAT,1,jmid,latid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'pulse',NF_FLOAT,1,mtotid,mid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'time',NF_FLOAT,1,elapmid,tid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc basis function surface maps ccccccccccccccccccccccccccccccccc c bfmap (landunit_s,landunit_sm1,oceanunit_s,oceanunit_sm1) vdims4(1) = imid; vdims4(2) = jmid; vdims4(3) = mtotid vdims4(4) = elapmid Do r = 1, lreg status = NF_DEF_VAR(ncid,bfname(r,cnt),NF_FLOAT,4,vdims4, ^ bfmapid(r)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,regions,time) ccccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,lonid,'long_name',29, ^ 'Longitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lonid,'units',12,'degrees_east') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'long_name',28, ^ 'Latitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'units',13,'degrees_north') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'long_name',5,'pulse') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,mid,'units',5,'pulse') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'long_name',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'units',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) cccccccccc basis function surface maps ccccccccccccccccccccccccccccccccc c bfmap (landunit_s,landunit_sm1,oceanunit_s,oceanunit_sm1) Do r = 1, lreg If (cnt==1) then regn='Terrestrial basis function, surface layer: region ' ^ //num(r) Elseif (cnt==2) then regn='Terrestrial basis function, layer above surface: region ' ^ //num(r) Elseif (cnt==3) then regn='Oceanic basis function, surface layer: region ' ^ //num(r) Elseif (cnt==4) then regn='Oceanic basis function, layer above surface: region ' ^ //num(r) Endif status = NF_PUT_ATT_TEXT(ncid,bfmapid(r),'long_name',58,regn) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,bfmapid(r),'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,bfmapid(r),'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,time) ccccccccccccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,lonid,lonvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,latid,latvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,mid,mvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,tid,evect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc basis function surface maps ccccccccccccccccccccccccccccccccc c bfmap (landunit_s,landunit_sm1,oceanunit_s,oceanunit_sm1) start4(1) = 1; start4(2)= 1; start4(3) = 1; start4(4) = 1 count4(1) = im; count4(2)= jm; count4(3) = mtot; count4(4) = elapm Do r = 1, lreg status = NF_PUT_VARA_REAL(ncid,bfmapid(r),start4,count4, ^ bfmap(:,:,r,:,:)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_5 SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.5.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_5(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect, ^ evect,landunit,monpulse) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: m,im,jm,pm,r, ^ mtot,lreg,elapm real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect real, dimension(:,:,:,:,:), intent(in) :: landunit character (len=80) :: regn character (len=2), dimension(lreg) :: num character (len=15), dimension(lreg) :: landname character (len=8), dimension(mtot) :: monpulse cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,imid, ^ jmid,pmid,elapmid, ^ lonid,latid,presid, ^ mid,tid, ^ landunit_regid(lreg), ^ vdims4(4), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c r : Loop index. Loops over lreg. c regn : A character variable used for the 'long_name' netCDF c attribute. c num : A character array containing the basis function region c number: 01 through 11. c landname : A character array containing the variable names for c the series of netCDF arrays associated with the CO2 c terrestrial basis function region 3D concentrations. c monpulse : A character array containing the month-pulse names. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c landunit_reg# : These ID's reduce the incoming landunit 5D array c into 4D arrays. There are 11 of these ID's, one c one for each terrestrial basis function region. c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO landname(1) = 'landunit_reg_01'; num(1) = '01' landname(2) = 'landunit_reg_02'; num(2) = '02' landname(3) = 'landunit_reg_03'; num(3) = '03' landname(4) = 'landunit_reg_04'; num(4) = '04' landname(5) = 'landunit_reg_05'; num(5) = '05' landname(6) = 'landunit_reg_06'; num(6) = '06' landname(7) = 'landunit_reg_07'; num(7) = '07' landname(8) = 'landunit_reg_08'; num(8) = '08' landname(9) = 'landunit_reg_09'; num(9) = '09' landname(10) = 'landunit_reg_10'; num(10) = '10' landname(11) = 'landunit_reg_11'; num(11) = '11' cOOOOOOOOO end variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.5_'//monpulse(m)//'.nc',0,ncid) write(*,*) 'output.L2.5_'//monpulse(m)//'.nc created' status = NF_DEF_DIM(ncid,'longitude',im,imid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'latitude',jm,jmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'height',pm,pmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'time',elapm,elapmid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_DEF_VAR(ncid,'longitude',NF_FLOAT,1,imid,lonid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'latitude',NF_FLOAT,1,jmid,latid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'height',NF_FLOAT,1,pmid,presid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'time',NF_FLOAT,1,elapmid,tid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c c landunit_reg1,landunit_reg2.... vdims4(1)=imid; vdims4(2)=jmid; vdims4(3)=pmid; vdims4(4)=elapmid Do r = 1, lreg status = NF_DEF_VAR(ncid,landname(r),NF_FLOAT,4,vdims4, ^ landunit_regid(r)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,lonid,'long_name',29, ^ 'Longitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lonid,'units',12,'degrees_east') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'long_name',28, ^ 'Latitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'units',13,'degrees_north') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'long_name',25, ^ 'Vertical gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'units',9,'millibars') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'long_name',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'units',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c landunit_reg1,landunit_reg2.... Do r = 1, lreg regn = '3D terrestrial basis function field: region '//num(r)// ^', '//monpulse(m) status = NF_PUT_ATT_TEXT(ncid,landunit_regid(r),'long_name',57, ^ regn) if (status .ne. nf_noerr) call handle_err(status) status=NF_PUT_ATT_TEXT(ncid,landunit_regid(r),'units',4,'ppmv') if (status .ne. nf_noerr) call handle_err(status) status=NF_PUT_ATT_REAL(ncid,landunit_regid(r),'missing_value', ^ NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,lonid,lonvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,latid,latvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,presid,presvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,tid,evect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c c landunit_reg1,landunit_reg2.... start4(1) = 1; start4(2) = 1; start4(3) = 1; start4(4) = 1 count4(1) = im; count4(2) = jm; count4(3) = pm; count4(4) = elapm Do r = 1, lreg status = NF_PUT_VARA_REAL(ncid,landunit_regid(r),start4,count4, ^ landunit(:,:,:,r,:)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO WRITE_CDF_2_6 SUBROUTINE OO cO OO cO This subroutine writes TransCom 3 level 2 output to a netCDF file OO cO called "output.L2.6.nc" OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine write_cdf_2_6(m,im,jm,pm,mtot,lreg,elapm, ^ lonvect,latvect,presvect,mvect,lvect, ^ evect,oceanunit,monpulse) cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO implicit none include 'netcdf.inc' integer :: m,im,jm,pm,r, ^ mtot,lreg,elapm real, parameter :: misval=1.0e+36 real, dimension(:), intent(in) :: lonvect,latvect, ^ presvect,mvect, ^ lvect,evect real, dimension(:,:,:,:,:), intent(in) :: oceanunit character (len=80) :: regn character (len=2), dimension(lreg) :: num character (len=16), dimension(lreg) :: oceanname character (len=8), dimension(mtot) :: monpulse cccccccccc netCDF integer declarations ccccccccccccccccccccccccccccccccc integer :: status,ncid,imid,jmid, ^ pmid,elapmid, ^ lonid,latid,presid, ^ mid,tid, ^ oceanunit_regid(lreg), ^ vdims4(4), ^ start4(4),count4(4) cOOOOOOOOO end variable declarations OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO c cccccccccc regular variables ccccccccccccccccccccccccccccccccccccccccccc c c misval : The designated TransCom missing value: 1.0e+36. c r : Loop index. Loops over lreg. c regn : A character variable used for the 'long_name' netCDF c attribute. c num : A character array containing the basis function region c number: 01 through 11. c oceanname : A character array containing the variable names for c the series of netCDF arrays associated with the CO2 c oceanic basis function region 3D concentrations. c monpulse : A character array containing the month-pulse names. c cccccccccc netcdf variables cccccccccccccccccccccccccccccccccccccccccccc c c ncid : The netCDF ID representing the open file. c XXXXXid : A series of ID's that correspond to those variables c names passed into the write_cdf subroutine. There are c three exceptions to this scheme. They are: c oceanunit_reg# : These ID's reduce the incoming oceanunit 5D array c into 4D arrays. There are 11 of these ID's, one c one for each oceanic basis function region. c vdims# : These are netCDF integer vectors whose elements c denote the dimensions of the netCDF arrays. c start# : These are netCDF integer vectors whose elements denote c where in the netCDF array the first element of a given c write statement should start. c count# : These are netCDF integer vectors whose elements denote c the edge lengths along each dimension of a given write c statement. c cOOOOOOOOO end variable description OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO oceanname(1) = 'oceanunit_reg_01'; num(1) = '01' oceanname(2) = 'oceanunit_reg_02'; num(2) = '02' oceanname(3) = 'oceanunit_reg_03'; num(3) = '03' oceanname(4) = 'oceanunit_reg_04'; num(4) = '04' oceanname(5) = 'oceanunit_reg_05'; num(5) = '05' oceanname(6) = 'oceanunit_reg_06'; num(6) = '06' oceanname(7) = 'oceanunit_reg_07'; num(7) = '07' oceanname(8) = 'oceanunit_reg_08'; num(8) = '08' oceanname(9) = 'oceanunit_reg_09'; num(9) = '09' oceanname(10) = 'oceanunit_reg_10'; num(10) = '10' oceanname(11) = 'oceanunit_reg_11'; num(11) = '11' cOOOOOOOOO end variable initialization OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO open netCDF file and define the dimensions OOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CREATE('output.L2.6_'//monpulse(m)//'.nc',0,ncid) Write(*,*) 'output.L2.6_'//monpulse(m)//'.nc created' status = NF_DEF_DIM(ncid,'longitude',im,imid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'latitude',jm,jmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'height',pm,pmid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_DIM(ncid,'time',elapm,elapmid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end open of netCDF file and dimension definition OOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_DEF_VAR(ncid,'longitude',NF_FLOAT,1,imid,lonid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'latitude',NF_FLOAT,1,jmid,latid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'height',NF_FLOAT,1,pmid,presid) if (status .ne. nf_noerr) call handle_err(status) status = NF_DEF_VAR(ncid,'time',NF_FLOAT,1,elapmid,tid) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c c oceanunit_reg1,oceanunit_reg2....... vdims4(1)=imid; vdims4(2)=jmid; vdims4(3)=pmid; vdims4(4)=elapmid Do r = 1, lreg status = NF_DEF_VAR(ncid,oceanname(r),NF_FLOAT,4,vdims4, ^ oceanunit_regid(r)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end define variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_PUT_ATT_TEXT(ncid,lonid,'long_name',29, ^ 'Longitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,lonid,'units',12,'degrees_east') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'long_name',28, ^ 'Latitudinal gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,latid,'units',13,'degrees_north') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'long_name',25, ^ 'Vertical gridcell centers') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,presid,'units',9,'millibars') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'long_name',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,tid,'units',13,'elapsed month') if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c oceanunit_reg1,oceanunit_reg2.... Do r = 1, lreg regn = '3D oceanic basis function field: region '//num(r)// ^', '//monpulse(m) status = NF_PUT_ATT_TEXT(ncid,oceanunit_regid(r),'long_name', ^ 53,regn) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_TEXT(ncid,oceanunit_regid(r),'units',4, ^ 'ppmv') if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_ATT_REAL(ncid,oceanunit_regid(r), ^ 'missing_value',NF_FLOAT,1,misval) if (status .ne. nf_noerr) call handle_err(status) End do cccccccccc close define mode ccccccccccccccccccccccccccccccccccccccccccc status = NF_ENDDEF(ncid) if (status .ne. nf_noerr) call handle_err(status) cOOOOOOOOO end apply attributes OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOO begin filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cccccccccc vectors (longitude,latitude,pressure,time) cccccccccccccccccc status = NF_PUT_VAR_REAL(ncid,lonid,lonvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,latid,latvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,presid,presvect) if (status .ne. nf_noerr) call handle_err(status) status = NF_PUT_VAR_REAL(ncid,tid,evect) if (status .ne. nf_noerr) call handle_err(status) cccccccccc 3D basis function fields cccccccccccccccccccccccccccccccccccc c c oceanunit_reg1,oceanunit_reg2.... start4(1) = 1; start4(2) = 1; start4(3) = 1; start4(4) = 1 count4(1) = im; count4(2) = jm; count4(3) = pm; count4(4) = elapm Do r = 1, lreg status = NF_PUT_VARA_REAL(ncid,oceanunit_regid(r),start4, ^ count4,oceanunit(:,:,:,r,:)) if (status .ne. nf_noerr) call handle_err(status) End do cOOOOOOOOO end filling variables OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOO close file and end subroutine OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO status = NF_CLOSE(ncid) if (status .ne. nf_noerr) call handle_err(status) Return End Subroutine write_cdf_2_6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cO Error-flagging subroutine OO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO cOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO Subroutine Handle_err(status) Implicit none include 'netcdf.inc' integer :: status If (status .ne. nf_noerr) then Write(*,*) NF_STRERROR(status) Stop End if Return End subroutine handle_err