! subroutine appenddat ! ! Append data read from stdin (see rdstdin.F) to existing glbmean ! source history file. ! use rdstdin implicit none #include ! ! Local: integer :: ncid,istat,id_nbins,id_nsftrf,id_nsfdim1,id_nsfdima, | id_nsfdimb,id_wv_low,id_wv_high,id_sminflx,id_smedflx, | id_smaxflx,id_vl1,id_vl2,id_sfx,id_sgry,id_sgo2hz,id_sgo31, | id_sgo32,id_aij,id_bij,id_ad00,id_ad10,id_bd00,id_bd10, | id_natm,id_nfatm,id_atm ! integer :: id_dims1(1),id_dims2(2) character(len=120) :: source character(len=120) :: char120 logical :: exists ! source = 'FOSTER.GLBMD01.glbmean.nc' ! ! File must be on the disk (not going to mss at this time): inquire(file=source,exist=exists) if (.not.exists) then write(6,"(/,'>>> appenddat: cannot find SOURCE history file', | a)") trim(source) stop 'source' endif ! ! Open netcdf file (for appending): istat = nf_open(source,NF_WRITE,ncid) if (istat /= NF_NOERR) then write(char120,"('Error return from nf_open for netcdf ', | 'file ',a,' istat=',a)") trim(source),istat call handle_ncerr(istat,char120) stop 'readfile' endif write(6,"(/,'appenddat: opened netcdf file ',a,' ncid=',i6)") | trim(source),ncid ! ! Put into define mode: istat = nf_redef(ncid) if (istat /= NF_NOERR) then write(char120,"('Error entering redef mode: istat=',i4)") | istat call handle_ncerr(istat,char120) stop 'appenddat' else write(6,"('Entered redefine mode..')") endif ! ! Define dimensions from stdin read: istat = nf_def_dim(ncid,'nbin_uars',nbins,id_nbins) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nbins dimension')") ! istat = nf_def_dim(ncid,'nsftrf',nsftrf,id_nsftrf) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nsftrf dimension')") ! istat = nf_def_dim(ncid,'nsfdim1',nsfdim1,id_nsfdim1) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nsfdim1 dimension')") ! istat = nf_def_dim(ncid,'nsfdima',nsfdima,id_nsfdima) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nsfdima dimension')") ! istat = nf_def_dim(ncid,'nsfdimb',nsfdimb,id_nsfdimb) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nsfdimb dimension')") ! integer, parameter :: natm=71,nfatm=8 ! real :: atm(natm,nfatm) ! istat = nf_def_dim(ncid,'natm',natm,id_natm) if (istat /= NF_NOERR) | write(6,"('>>> Error defining natm dimension')") ! istat = nf_def_dim(ncid,'nfatm',nfatm,id_nfatm) if (istat /= NF_NOERR) | write(6,"('>>> Error defining nfatm dimension')") ! write(6,"('appenddat: id_nbins=',i3,' id_nsftrf=',i3, | ' id_nsfdim1=',i3,' id_nsfdima=',i3,' id_nsfdimb=', | i3)") id_nbins,id_nsftrf,id_nsfdim1,id_nsfdima,id_nsfdimb write(6,"('appenddat: id_natm=',i3,' id_nfatm=',i3)") | id_natm,id_nfatm ! ! Define uars flux variables: ! id_dims1(1) = id_nbins istat = nf_def_var(ncid,'wv_low',NF_DOUBLE,1,id_dims1, | id_wv_low) if (istat /= NF_NOERR) | write(6,"('>>> Error defining wv_low variable')") ! istat = nf_def_var(ncid,'wv_high',NF_DOUBLE,1,id_dims1, | id_wv_high) if (istat /= NF_NOERR) | write(6,"('>>> Error defining wv_high variable')") ! istat = nf_def_var(ncid,'sminflx',NF_DOUBLE,1,id_dims1, | id_sminflx) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sminflx variable')") ! istat = nf_def_var(ncid,'smedflx',NF_DOUBLE,1,id_dims1, | id_smedflx) if (istat /= NF_NOERR) | write(6,"('>>> Error defining smedflx variable')") ! istat = nf_def_var(ncid,'smaxflx',NF_DOUBLE,1,id_dims1, | id_smaxflx) if (istat /= NF_NOERR) | write(6,"('>>> Error defining smaxflx variable')") ! write(6,"('appenddat: id_wv_low=',i3,' id_wv_high=',i3, | ' id_sminflx=',i3,' id_smedflx=',i3,' id_smaxflx=',i3)") | id_wv_low,id_wv_high,id_sminflx,id_smedflx,id_smaxflx ! ! Define remaining variables: ! integer,parameter :: nsftrf=158 ! real,dimension(nsftrf) :: ! | vl1 ,vl2 ,sfx ,sgry ,sgo2hz ,sgo31 ,sgo32 ! id_dims1(1) = id_nsftrf ! istat = nf_def_var(ncid,'vl1',NF_DOUBLE,1,id_dims1,id_vl1) if (istat /= NF_NOERR) | write(6,"('>>> Error defining vl1 variable')") ! istat = nf_def_var(ncid,'vl2',NF_DOUBLE,1,id_dims1,id_vl2) if (istat /= NF_NOERR) | write(6,"('>>> Error defining vl2 variable')") ! istat = nf_def_var(ncid,'sfx',NF_DOUBLE,1,id_dims1,id_sfx) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sfx variable')") ! istat = nf_def_var(ncid,'sgry',NF_DOUBLE,1,id_dims1,id_sgry) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sgry variable')") ! istat = nf_def_var(ncid,'sgo2hz',NF_DOUBLE,1,id_dims1, | id_sgo2hz) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sgo2hz variable')") ! istat = nf_def_var(ncid,'sgo31',NF_DOUBLE,1,id_dims1, | id_sgo31) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sgo31 variable')") ! istat = nf_def_var(ncid,'sgo32',NF_DOUBLE,1,id_dims1, | id_sgo32) if (istat /= NF_NOERR) | write(6,"('>>> Error defining sgo32 variable')") ! write(6,"('appenddat: id_vl1=',i3,' id_vl2=',i3,' id_sfx=',i3, | ' id_sgry=',i3,' id_sgo2hz=',i3,' id_sgo31=',i3, | ' id_sgo32=',i3)") id_vl1,id_vl2,id_sfx,id_sgry,id_sgo2hz, | id_sgo31,id_sgo32 ! ! integer,parameter :: nsfdim1=17, nsfdima=9, nsfdimb=5 ! real,dimension(nsfdim1,nsfdima) :: aij ! real,dimension(nsfdim1,nsfdimb) :: bij ! real,dimension(nsfdima) :: ad00, ad10 ! real,dimension(nsfdimb) :: bd00, bd10 ! id_dims2(1) = id_nsfdim1 id_dims2(2) = id_nsfdima istat = nf_def_var(ncid,'aij',NF_DOUBLE,2,id_dims2, | id_aij) if (istat /= NF_NOERR) | write(6,"('>>> Error defining aij variable')") ! id_dims2(2) = id_nsfdimb istat = nf_def_var(ncid,'bij',NF_DOUBLE,2,id_dims2, | id_bij) if (istat /= NF_NOERR) | write(6,"('>>> Error defining bij variable')") ! id_dims1(1) = id_nsfdima istat = nf_def_var(ncid,'ad00',NF_DOUBLE,1,id_dims1, | id_ad00) if (istat /= NF_NOERR) | write(6,"('>>> Error defining ad00 variable')") ! istat = nf_def_var(ncid,'ad10',NF_DOUBLE,1,id_dims1, | id_ad10) if (istat /= NF_NOERR) | write(6,"('>>> Error defining ad10 variable')") ! id_dims1(1) = id_nsfdimb istat = nf_def_var(ncid,'bd00',NF_DOUBLE,1,id_dims1, | id_bd00) if (istat /= NF_NOERR) | write(6,"('>>> Error defining bd00 variable')") ! istat = nf_def_var(ncid,'bd10',NF_DOUBLE,1,id_dims1, | id_bd10) if (istat /= NF_NOERR) | write(6,"('>>> Error defining bd10 variable')") ! ! integer, parameter :: natm=71,nfatm=8 ! real :: atm(natm,nfatm) ! id_dims2(1) = id_natm id_dims2(2) = id_nfatm istat = nf_def_var(ncid,'atm',NF_DOUBLE,2,id_dims2, | id_atm) if (istat /= NF_NOERR) | write(6,"('>>> Error defining atm variable')") ! write(6,"('appenddat: id_aij=',i3,' id_bij=',i3,' id_ad00=', | i3,' id_ad10=',i3,' id_bd00=',i3,' id_bd10=',i3)") | id_aij,id_bij,id_ad00,id_ad10,id_bd00,id_bd10 write(6,"('appenddat: id_atm=',i3)") id_atm ! ! Take out of define mode: istat = nf_enddef(ncid) if (istat /= NF_NOERR) then write(char120,"('Error exiting redef mode: istat=',i4)") | istat call handle_ncerr(istat,char120) stop 'appenddat' else write(6,"('Exited redefine mode..')") endif ! ! Put variable values onto file: ! real,dimension(nflxbins) :: ! | wv_low, wv_high, sminflx, smedflx, smaxflx ! istat = nf_put_var_double(ncid,id_wv_low,wv_low) if (istat /= NF_NOERR) | write(6,"('>>> Error writing wv_low variable')") ! istat = nf_put_var_double(ncid,id_wv_high,wv_high) if (istat /= NF_NOERR) | write(6,"('>>> Error writing wv_high variable')") ! istat = nf_put_var_double(ncid,id_sminflx,sminflx) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sminflx variable')") ! istat = nf_put_var_double(ncid,id_smedflx,smedflx) if (istat /= NF_NOERR) | write(6,"('>>> Error writing smedflx variable')") ! istat = nf_put_var_double(ncid,id_smaxflx,smaxflx) if (istat /= NF_NOERR) | write(6,"('>>> Error writing smaxflx variable')") ! ! | vl1 ,vl2 ,sfx ,sgry ,sgo2hz ,sgo31 ,sgo32 ! istat = nf_put_var_double(ncid,id_vl1,vl1) if (istat /= NF_NOERR) | write(6,"('>>> Error writing vl1 variable')") ! istat = nf_put_var_double(ncid,id_vl2,vl2) if (istat /= NF_NOERR) | write(6,"('>>> Error writing vl2 variable')") ! istat = nf_put_var_double(ncid,id_sfx,sfx) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sfx variable')") ! istat = nf_put_var_double(ncid,id_sgry,sgry) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sgry variable')") ! istat = nf_put_var_double(ncid,id_sgo2hz,sgo2hz) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sgo2hz variable')") ! istat = nf_put_var_double(ncid,id_sgo31,sgo31) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sgo31 variable')") ! istat = nf_put_var_double(ncid,id_sgo32,sgo32) if (istat /= NF_NOERR) | write(6,"('>>> Error writing sgo32 variable')") ! ! real,dimension(nsfdim1,nsfdima) :: aij ! real,dimension(nsfdim1,nsfdimb) :: bij ! real,dimension(nsfdima) :: ad00, ad10 ! real,dimension(nsfdimb) :: bd00, bd10 ! istat = nf_put_var_double(ncid,id_aij,aij) if (istat /= NF_NOERR) | write(6,"('>>> Error writing aij variable')") ! istat = nf_put_var_double(ncid,id_bij,bij) if (istat /= NF_NOERR) | write(6,"('>>> Error writing bij variable')") ! istat = nf_put_var_double(ncid,id_ad00,ad00) if (istat /= NF_NOERR) | write(6,"('>>> Error writing ad00 variable')") ! istat = nf_put_var_double(ncid,id_ad10,ad10) if (istat /= NF_NOERR) | write(6,"('>>> Error writing ad10 variable')") ! istat = nf_put_var_double(ncid,id_bd00,bd00) if (istat /= NF_NOERR) | write(6,"('>>> Error writing bd00 variable')") ! istat = nf_put_var_double(ncid,id_bd10,bd10) if (istat /= NF_NOERR) | write(6,"('>>> Error writing bd10 variable')") ! integer, parameter :: natm=71,nfatm=8 ! real :: atm(natm,nfatm) istat = nf_put_var_double(ncid,id_atm,atm) if (istat /= NF_NOERR) | write(6,"('>>> Error writing atm variable')") ! ! Close file: istat = nf_close(ncid) if (istat /= NF_NOERR) | write(6,"('>>> Error closing file ',a)") trim(source) end subroutine appenddat !------------------------------------------------------------------- subroutine handle_ncerr(istat,msg) implicit none #include ! ! Handle a netcdf lib error: ! integer,intent(in) :: istat character(len=*),intent(in) :: msg ! write(6,"(/72('-'))") write(6,"('>>> Error from netcdf library:')") write(6,"(a)") trim(msg) write(6,"('istat=',i5)") istat write(6,"(a)") nf_strerror(istat) write(6,"(72('-')/)") return end subroutine handle_ncerr