!=============================================================================== ! CVS $Id$ ! CVS $Source$ ! CVS $Name$ !=============================================================================== PROGRAM reformat_sst IMPLICIT NONE !--- includes --- include 'netcdf.inc' ! netCDF defs !--- domain data --- integer :: ni ! size of i-axis of 2d domain integer :: nj ! size of j-axis of 2d domain integer,parameter :: nt=12 ! size of time dimension real ,allocatable :: xc (:,:) ! x-coords of center real ,allocatable :: yc (:,:) ! y-coords of center integer,allocatable :: mask (:,:) ! domain mask real ,allocatable :: sst (:,:,:) ! domain mask real ,allocatable :: ifrac(:,:,:) ! domain mask real ,parameter :: tfreeze = 273.16 real ,parameter :: spval = 1.0e30 real :: time(12) = (/16,45,75,105,136,166,197,228,258,289,319,350 /) integer :: date(12) = (/116,214,316,415,516,615,716,816,915,1016,1115,1216 /) integer :: datesec(12) = (/ 0,0,0, 0,0,0, 0,0,0, 0,0,0 /) !--- local --- character( 8) :: cdate ! wall clock date character(10) :: ctime ! wall clock time integer :: rcode ! routine return error code integer :: fid ! nc file ID integer :: vid ! nc variable ID integer :: did ! nc dimension ID integer :: vdid(3) ! vector of nc dimension ID integer :: i,j,k,n,m ! generic indicies character(512) :: str ! fixed length char string character(512) :: str_title ! global attribute str - title character(512) :: str_source ! global attribute str - source character(512) :: str_history! global attribute str - history character(512) :: source ! optional global att str - source character(512) :: history ! optional global att str - history character(512) :: title ! replacement global att str - title integer :: strlen ! (trimmed) length of string character(80) :: fn_in ! file name ( input nc file) character(80) :: fn_out ! file name (output nc file) character(32) :: attstr ! netCDF attribute name string real,parameter :: pi = 3.14159265358979323846 ! NAMELIST / in_parm / fn_in, fn_out, title, source !--- formats --- character(*),parameter :: F00 = "(120a )" character(*),parameter :: F02 = "(a,4i6)" character(*),parameter :: F10 = "('Data created: 'i4,'-',i2,2('-',i2),' ',i2,2('-',i2),' ')" !------------------------------------------------------------------------------- ! PURPOSE: ! o given a SCRIP map matrix data file, create a docn/dice domain data file ! ! NOTES: ! o all output data is base on the "_a" grid, the "_b" grid is ignored ! o to compile on an NCAR's SGI, utefe (Feb 2001): ! unix> f90 -64 -mips4 -r8 -i4 -lfpe -I/usr/local/include Make_domain.F90 \ ! -L/usr/local/lib64/r4i4 -lnetcdf ! o to compile on an NCAR's IBM, blackforest (Jun 2003): use current Macros.AIX !------------------------------------------------------------------------------- write(6,F00) 'create a dice5/docn5 domain file from a scrip matrix data file' !---------------------------------------------------------------------------- write(6,F00) 'input namelist data...' !---------------------------------------------------------------------------- fn_in ='a0190-xx-xx.nc' fn_out='sst_clim_b20.001_gx1v3_030618.nc' title ='null' source='null' history='null' ! read(*,nml=in_parm) write(*,*) 'fn_in = ',trim(fn_in ) write(*,*) 'fn_out = ',trim(fn_out) write(*,*) 'title = ',trim(title ) write(*,*) 'source = ',trim(source) write(*,*) 'history= ',trim(history) !---------------------------------------------------------------------------- write(6,F00) 'input EXISTING data...' !---------------------------------------------------------------------------- !--- document global attributes ----------------- write(6,F00) 'o file = ',fn_in(1:len_trim(fn_in)) rcode = nf_open(fn_in(1:len_trim(fn_in)),NF_NOWRITE,fid) if (rcode /= NF_NOERR) write(*,F00) nf_strerror(rcode) rcode = nf_get_att_text(fid, NF_GLOBAL, 'title' , str_title ) write(6,F00) 'o title = ',trim(str_title) if (title(1:4) /= 'null') str_title=title rcode = nf_get_att_text(fid, NF_GLOBAL, 'source' , str_source) write(6,F00) 'o source = ',trim(str_source) if (source(1:4) /= 'null') str_source=source rcode = nf_get_att_text(fid, NF_GLOBAL, 'history' , str_history) write(6,F00) 'o history = ',trim(str_history) if (history(1:4) /= 'null') str_history=history !---------------------------------------------- ! get domain info for source grid !---------------------------------------------- rcode = nf_inq_dimid (fid, 'ni_o',did) rcode = nf_inq_dimlen(fid, did , ni) rcode = nf_inq_dimid (fid, 'nj_o',did) rcode = nf_inq_dimlen(fid, did , nj) write(6,F02) 'o ni,nj=',ni,nj allocate( xc (ni,nj) ) ! x-coordinates of center allocate( yc (ni,nj) ) ! y-coordinates of center allocate( mask (ni,nj) ) ! domain mask allocate( sst (ni,nj,nt)) ! sst allocate( ifrac(ni,nj,nt)) ! ice fraction rcode = nf_inq_varid (fid,'xc_o',vid) rcode = nf_get_var_double(fid,vid, xc ) rcode = nf_inq_varid (fid,'yc_o',vid) rcode = nf_get_var_double(fid,vid, yc ) rcode = nf_inq_varid (fid,'mask_o',vid ) rcode = nf_get_var_int (fid,vid,mask ) rcode = nf_inq_varid (fid,'So_o_t',vid ) rcode = nf_get_var_double(fid,vid,sst ) sst = sst - tfreeze rcode = nf_inq_varid (fid,'Si_i_ifrac',vid ) rcode = nf_get_var_double(fid,vid,ifrac ) rcode = nf_close(fid) ! !---------------------------------------------------------------------------- write(6,F00) 'output CSM data...' !---------------------------------------------------------------------------- !----------------------------------------------------------------- ! create a new nc file !----------------------------------------------------------------- rcode = nf_create(trim(fn_out),NF_CLOBBER,fid) if (rcode /= NF_NOERR) write(*,F00) nf_strerror(rcode) !----------------------------------------------------------------- ! global attributes !----------------------------------------------------------------- str = 'docn5 monthly sst data derived from a CCSM coupled run' str = trim(str) // ' --- ' // str_title rcode = nf_put_att_text(fid,NF_GLOBAL,'title' ,len_trim(str),str) str = 'CCSM2.0 - docn5 input sst/ifrac format' rcode = nf_put_att_text(fid,NF_GLOBAL,'conventions',len_trim(str),str) str = source if ( str(1:4) /= 'null' ) & & rcode = nf_put_att_text(fid,NF_GLOBAL,'source' ,len_trim(str),str) call date_and_time(cdate,ctime) str = 'File reformatted: '//cdate(1:4)//'-'//cdate(5:6)//'-'//cdate(7:8) & & //' '//ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6) & & // " \n" // trim(str_history) rcode = nf_put_att_text(fid,NF_GLOBAL,'history' ,len_trim(str),str) !----------------------------------------------------------------- ! dimension data !----------------------------------------------------------------- rcode = nf_def_dim(fid, 'ni' , ni, did) ! # of points wrt i rcode = nf_def_dim(fid, 'nj' , nj, did) ! # of points wrt j rcode = nf_def_dim(fid, 'time', nt, did) ! # of points wrt t !----------------------------------------------------------------- ! define data -- coordinates, input grid !----------------------------------------------------------------- rcode = nf_inq_dimid(fid,'ni' ,vdid(1)) !----------------------- rcode = nf_inq_dimid(fid,'nj' ,vdid(2)) rcode = nf_def_var (fid,'xc' ,NF_FLOAT ,2,vdid,vid) str = 'longitude of grid cell center' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'degrees east' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) rcode = nf_def_var (fid,'yc' ,NF_FLOAT ,2,vdid,vid) str = 'latitude of grid cell center' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'degrees north' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) rcode = nf_def_var (fid,'mask',NF_INT ,2,vdid,vid) str = 'domain mask' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) rcode = nf_inq_dimid(fid,'time',vdid(1)) !------------------ rcode = nf_def_var (fid,'time',NF_FLOAT ,1,vdid,vid) str = 'time' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'days since 0000-01-01 00:00:00' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) str = 'noleap' rcode = nf_put_att_text(fid,vid,"calendar" ,len_trim(str),str) rcode = nf_def_var (fid,'date',NF_INT ,1,vdid,vid) str = 'calendary date' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'yyyymmdd' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) rcode = nf_def_var (fid,'datesec',NF_INT ,1,vdid,vid) str = 'seconds elapsed on calendar date' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'seconds' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) rcode = nf_inq_dimid(fid,'ni' ,vdid(1)) !----------------------- rcode = nf_inq_dimid(fid,'nj' ,vdid(2)) rcode = nf_inq_dimid(fid,'time',vdid(3)) rcode = nf_def_var (fid,'sst',NF_FLOAT ,3,vdid,vid) str = 'sea surface temperature' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'degress C' rcode = nf_put_att_text(fid,vid,"units" ,len_trim(str),str) rcode = nf_put_att_double(fid,vid,"missing_value",NF_FLOAT,1,spval) rcode = nf_put_att_double(fid,vid,"_FillValue" ,NF_FLOAT,1,spval) rcode = nf_def_var (fid,'ifrac',NF_FLOAT ,3,vdid,vid) str = 'ice fraction' rcode = nf_put_att_text(fid,vid,"long_name",len_trim(str),str) str = 'fraction ranges from 0 to 1' rcode = nf_put_att_text(fid,vid,"comment" ,len_trim(str),str) rcode = nf_put_att_double(fid,vid,"missing_value",NF_FLOAT,1,spval) rcode = nf_put_att_double(fid,vid,"_FillValue" ,NF_FLOAT,1,spval) !----------------------------------------------------------------- write(6,F00) 'o put data...' !----------------------------------------------------------------- rcode = nf_enddef(fid) rcode = nf_inq_varid (fid, 'xc' ,vid) rcode = nf_put_var_double(fid, vid , xc) rcode = nf_inq_varid (fid, 'yc' ,vid) rcode = nf_put_var_double(fid, vid , yc) rcode = nf_inq_varid (fid,'mask',vid) rcode = nf_put_var_int (fid, vid ,mask) rcode = nf_inq_varid (fid,'time',vid) rcode = nf_put_var_double(fid, vid ,time) rcode = nf_inq_varid (fid,'date',vid) rcode = nf_put_var_int (fid, vid ,date) rcode = nf_inq_varid (fid,'datesec',vid) rcode = nf_put_var_int (fid, vid ,datesec) rcode = nf_inq_varid (fid,'sst',vid) rcode = nf_put_var_double(fid, vid ,sst) rcode = nf_inq_varid (fid,'ifrac',vid) rcode = nf_put_var_double(fid, vid ,ifrac) rcode = nf_close(fid) if (rcode /= NF_NOERR) write(*,F00) nf_strerror(rcode) END PROGRAM !===============================================================================