Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- !_________________________________________________________
- ! This program will read binary data from all grid points
- ! and calculate the monthly mean. On the other hand, this
- ! program will the single scattering albedo only for the
- ! valid data and write into a new binary file. For each
- ! binary file there will also be a control (.ctl) file
- ! created for grads manipulation later.
- !=========================================================
- ! This program has been created and modified by =.Taufiq Hassan.=
- ! For more info. email: taufiq@gist.ac.kr
- ! Thanks to .Damien Decremer.
- !_________________________________________________________
- program rea
- implicit none
- !============Defining all variables================================!
- real, parameter :: UNDEF = -9999.0
- character :: filename*30,monname*30,ctlfile*30
- integer :: i,ios,j,k,m,c1(360,180),c2(360,180),c3(360,180),c4(360,180),p,q
- integer, parameter:: n=31
- logical:: exist
- integer,parameter::NX=360,NY=180,NZ=1,NT=1,NV=6,NS=0
- real:: aaod388(nx,ny),aaod500(nx,ny),aeod388(nx,ny),aeod500(nx,ny)
- real:: ssa388(nx,ny),ssa500(nx,ny)
- real::summ1(nx,ny), naaod388(nx,ny),naaod500(nx,ny),naeod388(nx,ny),naeod500(nx,ny),summ2(nx,ny),summ3(nx,ny),summ4(nx,ny)
- !====================Loop for yearly calculations=======================!
- do q=2004,2012
- summ1(:,:) = 0.0
- summ2(:,:) = 0.0
- summ3(:,:) = 0.0
- summ4(:,:) = 0.0
- c1(:,:)=0
- c2(:,:)=0
- c3(:,:)=0
- c4(:,:)=0
- !===================Loop for Monthly calculations=======================!
- do p=10,12
- summ1(:,:) = 0.0
- summ2(:,:) = 0.0
- summ3(:,:) = 0.0
- summ4(:,:) = 0.0
- c1(:,:)=0
- c2(:,:)=0
- c3(:,:)=0
- c4(:,:)=0
- !=================Loop for daily calculations===========================!
- do i =1,n
- write(filename,fmt='(a,I4,a,I2,a,I0,a)') 'OMI-OMAERUV_',q,'m',p,'d',i,'.data'
- inquire(file=filename, exist=exist)
- if (exist) then
- ! print*, filename
- open(unit = 10, File=filename,status='unknown', &
- form='unformatted',access = 'direct', recl=4*NX*NY)
- ! !read all data in this part
- read (10,rec=3) aaod388
- read(10,rec=5)aaod500
- read(10,rec=4)aeod388
- read(10,rec=6)aeod500
- !=================Calculate the Summation===============================!
- do j=1,360
- do k= 1,180
- if (aaod388(j,k) > -1.0) then
- c1(j,k)=c1(j,k)+1
- summ1(j,k)=summ1(j,k)+aaod388(j,k)
- end if
- if (aaod500(j,k) > -1.0) then
- c2(j,k)=c2(j,k)+1
- summ2(j,k)=summ2(j,k)+aaod500(j,k)
- end if
- if (aeod388(j,k) > -1.0) then
- c3(j,k)=c3(j,k)+1
- summ3(j,k)=summ3(j,k)+aeod388(j,k)
- end if
- if (aeod500(j,k) > -1.0) then
- c4(j,k)=c4(j,k)+1
- summ4(j,k)=summ4(j,k)+aeod500(j,k)
- end if
- end do
- end do
- else
- end if
- end do
- !==================Calculate the mean======================================!
- do j=1,360
- do k= 1,180
- naaod388(j,k)=summ1(j,k)/c1(j,k)
- naaod500(j,k)=summ2(j,k)/c2(j,k)
- naeod388(j,k)=summ3(j,k)/c3(j,k)
- naeod500(j,k)=summ4(j,k)/c4(j,k)
- if (naeod388(j,k) > naaod388(j,k)) then
- ssa388(j,k)=(naeod388(j,k)-naaod388(j,k))/naeod388(j,k)
- else
- ssa388(j,k) = UNDEF
- end if
- if (naeod500(j,k)> naaod500(j,k)) then
- ssa500(j,k)=(naeod500(j,k)-naaod500(j,k))/naeod500(j,k)
- else
- ssa500(j,k) = UNDEF
- end if
- end do
- end do
- close (10)
- !===================Write data into a different binary file========================!
- write(monname,fmt='(a,I4,a,I2,a)') 'OMI-Monmean_',q,'m',p,'.data'
- open(12, file=monname, status="unknown",action='write', &
- form='unformatted',access = 'direct', recl=4*NX*NY)
- write (12,rec=1)naaod388
- write (12,rec=2)naaod500
- write (12,rec=3)naeod388
- write (12,rec=4)naeod500
- write (12,rec=5)ssa388
- write (12,rec=6)ssa500
- close(12)
- !====================Create .ctl file for each binary file=========================!
- write(ctlfile,fmt='(a,I4,a,I2,a)') 'OMI-Monmean_',q,'m',p,'.ctl'
- open(04,file=ctlfile,form='formatted',status='unknown')
- write(04,'(a,a,I4,a,I2,a)') 'DSET',' OMI-Monmean_',q,'m',p,'.data'
- write(04,'(A,F0.1)') 'UNDEF ',UNDEF
- write(04,'(A)') '*'
- write(04,'(A)') 'TITLE OMI/Aura Near UV Aerosol Optical Depth and Single Scattering Albedo - Raw res'
- write(04,'(A,I3,A)') 'XDEF ',NX,' LINEAR -179.500000 1.000000'
- write(04,'(A,I3,A)') 'YDEF ',NY,' LINEAR -89.500000 1.000000'
- write(04,'(A,I0,A)') 'ZDEF ',NZ,' LEVELS 1000'
- write(04,'(A)') '*'
- write(04,'(A,I0,A)') 'TDEF ',NT,' LINEAR Oct2004 1mo'
- write(04,'(A)') '*'
- write(04,'(A,I0)') 'VARS ',NV
- write(04,'(A,I0,A)') 'AAOD388 ',NS,' 99 Final Aerosol Absorption Optical Depth at 388 nm'
- write(04,'(A,I0,A)') 'AAOD500 ',NS,' 99 Final Aerosol Absorption Optical Depth at 500 nm'
- write(04,'(A,I0,A)') 'AEOD388 ',NS,' 99 Final Aerosol Extinction Optical Depth at 388 nm'
- write(04,'(A,I0,A)') 'AEOD500 ',NS,' 99 Final Aerosol Extinction Optical Depth at 500 nm'
- write(04,'(A,I0,A)') 'SSA388 ',NS,' 99 Final Aerosol Single Scattering Albedo at 388 nm'
- write(04,'(A,I0,A)') 'SSA500 ',NS,' 99 Final Aerosol Single Scattering Albedo at 500 nm'
- write(04,'(A)') 'ENDVARS'
- write(04,'(A)') '*'
- close(04)
- end do
- end do
- !______________________________________________________________________
- !=========================Part 2 starts here=============================================
- !====================Loop for yearly calculations=======================!
- do q=2005,2013
- summ1(:,:) = 0.0
- summ2(:,:) = 0.0
- summ3(:,:) = 0.0
- summ4(:,:) = 0.0
- c1(:,:)=0
- c2(:,:)=0
- c3(:,:)=0
- c4(:,:)=0
- !===================Loop for Monthly calculations=======================!
- do p=1,9
- summ1(:,:) = 0.0
- summ2(:,:) = 0.0
- summ3(:,:) = 0.0
- summ4(:,:) = 0.0
- c1(:,:)=0
- c2(:,:)=0
- c3(:,:)=0
- c4(:,:)=0
- !=================Loop for daily calculations===========================!
- do i =1,n
- write(filename,fmt='(a,I4,a,I0,a,I0,a)') 'OMI-OMAERUV_',q,'m',p,'d',i,'.data'
- inquire(file=filename, exist=exist)
- if (exist) then
- ! print*, filename
- open(unit = 10, File=filename,status='unknown', &
- form='unformatted',access = 'direct', recl=4*NX*NY)
- ! !read all data in this part
- read (10,rec=3) aaod388
- read(10,rec=5)aaod500
- read(10,rec=4)aeod388
- read(10,rec=6)aeod500
- !=================Calculate the Summation===============================!
- do j=1,360
- do k= 1,180
- if (aaod388(j,k) > -1.0) then
- c1(j,k)=c1(j,k)+1
- summ1(j,k)=summ1(j,k)+aaod388(j,k)
- end if
- if (aaod500(j,k) > -1.0) then
- c2(j,k)=c2(j,k)+1
- summ2(j,k)=summ2(j,k)+aaod500(j,k)
- end if
- if (aeod388(j,k) > -1.0) then
- c3(j,k)=c3(j,k)+1
- summ3(j,k)=summ3(j,k)+aeod388(j,k)
- end if
- if (aeod500(j,k) > -1.0) then
- c4(j,k)=c4(j,k)+1
- summ4(j,k)=summ4(j,k)+aeod500(j,k)
- end if
- end do
- end do
- else
- end if
- end do
- !==================Calculate the mean======================================!
- do j=1,360
- do k= 1,180
- naaod388(j,k)=summ1(j,k)/c1(j,k)
- naaod500(j,k)=summ2(j,k)/c2(j,k)
- naeod388(j,k)=summ3(j,k)/c3(j,k)
- naeod500(j,k)=summ4(j,k)/c4(j,k)
- if (naeod388(j,k) > naaod388(j,k)) then
- ssa388(j,k)=(naeod388(j,k)-naaod388(j,k))/naeod388(j,k)
- else
- ssa388(j,k) = UNDEF
- end if
- if (naeod500(j,k)> naaod500(j,k)) then
- ssa500(j,k)=(naeod500(j,k)-naaod500(j,k))/naeod500(j,k)
- else
- ssa500(j,k) = UNDEF
- end if
- end do
- end do
- close (10)
- !===================Write data into a different binary file========================!
- write(monname,fmt='(a,I4,a,I0,a)') 'OMI-Monmean_',q,'m',p,'.data'
- open(12, file=monname, status="unknown",action='write', &
- form='unformatted',access = 'direct', recl=4*NX*NY)
- write (12,rec=1)naaod388
- write (12,rec=2)naaod500
- write (12,rec=3)naeod388
- write (12,rec=4)naeod500
- write (12,rec=5)ssa388
- write (12,rec=6)ssa500
- close(12)
- !====================Create .ctl file for each binary file=========================!
- write(ctlfile,fmt='(a,I4,a,I0,a)') 'OMI-Monmean_',q,'m',p,'.ctl'
- open(04,file=ctlfile,form='formatted',status='unknown')
- write(04,'(a,a,I4,a,I0,a)') 'DSET',' OMI-Monmean_',q,'m',p,'.data'
- write(04,'(A,F0.1)') 'UNDEF ',UNDEF
- write(04,'(A)') '*'
- write(04,'(A)') 'TITLE OMI/Aura Near UV Aerosol Optical Depth and Single Scattering Albedo - Raw res'
- write(04,'(A,I3,A)') 'XDEF ',NX,' LINEAR -179.500000 1.000000'
- write(04,'(A,I3,A)') 'YDEF ',NY,' LINEAR -89.500000 1.000000'
- write(04,'(A,I0,A)') 'ZDEF ',NZ,' LEVELS 1000'
- write(04,'(A)') '*'
- write(04,'(A,I0,A)') 'TDEF ',NT,' LINEAR Oct2004 1mo'
- write(04,'(A)') '*'
- write(04,'(A,I0)') 'VARS ',NV
- write(04,'(A,I0,A)') 'AAOD388 ',NS,' 99 Final Aerosol Absorption Optical Depth at 388 nm'
- write(04,'(A,I0,A)') 'AAOD500 ',NS,' 99 Final Aerosol Absorption Optical Depth at 500 nm'
- write(04,'(A,I0,A)') 'AEOD388 ',NS,' 99 Final Aerosol Extinction Optical Depth at 388 nm'
- write(04,'(A,I0,A)') 'AEOD500 ',NS,' 99 Final Aerosol Extinction Optical Depth at 500 nm'
- write(04,'(A,I0,A)') 'SSA388 ',NS,' 99 Final Aerosol Single Scattering Albedo at 388 nm'
- write(04,'(A,I0,A)') 'SSA500 ',NS,' 99 Final Aerosol Single Scattering Albedo at 500 nm'
- write(04,'(A)') 'ENDVARS'
- write(04,'(A)') '*'
- close(04)
- end do
- end do
- end
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement