| 1 | MODULE avg_horiz_mod |
|---|
| 2 | |
|---|
| 3 | IMPLICIT NONE |
|---|
| 4 | |
|---|
| 5 | CONTAINS |
|---|
| 6 | |
|---|
| 7 | subroutine avg_horiz(imo,jmo,imn,jmn,rlonuo,rlatvo,rlonv, |
|---|
| 8 | . rlatu,zdata,outdata) |
|---|
| 9 | |
|---|
| 10 | c======================================================================= |
|---|
| 11 | c Maximum/minimum value composite approach for interpolate the variables |
|---|
| 12 | c from surface.nc (summit, base... ) |
|---|
| 13 | c Chao Wang |
|---|
| 14 | c======================================================================= |
|---|
| 15 | |
|---|
| 16 | implicit none |
|---|
| 17 | !inputs/outputs |
|---|
| 18 | integer, intent(in) :: imo,jmo |
|---|
| 19 | integer, intent(in) :: imn,jmn |
|---|
| 20 | real, intent(in) :: rlonv(imn+1) |
|---|
| 21 | real, intent(in) :: rlatu(jmn+1) |
|---|
| 22 | real, intent(in) :: zdata(imo*jmo) |
|---|
| 23 | real, intent(out) :: outdata(imn+1,jmn+1) |
|---|
| 24 | |
|---|
| 25 | !local variables: |
|---|
| 26 | real pi |
|---|
| 27 | integer i,j,l,m,n |
|---|
| 28 | real tmplon(imn+2) |
|---|
| 29 | real tmplat(jmn+2) |
|---|
| 30 | real rlonuo(imo) |
|---|
| 31 | real rlatvo(jmo) |
|---|
| 32 | |
|---|
| 33 | integer iik(imo,jmo),jjk(imo,jmo) |
|---|
| 34 | integer tmp |
|---|
| 35 | integer nmesh |
|---|
| 36 | |
|---|
| 37 | c initialize |
|---|
| 38 | iik(:,:)=0 |
|---|
| 39 | jjk(:,:)=0 |
|---|
| 40 | outdata(:,:)=0. |
|---|
| 41 | pi=2.*ASIN(1.) |
|---|
| 42 | |
|---|
| 43 | tmplon(1)=rlonv(1) |
|---|
| 44 | do i=2,imn+1 |
|---|
| 45 | tmplon(i)= (rlonv(i-1)+rlonv(i))/2. |
|---|
| 46 | enddo |
|---|
| 47 | tmplon(imn+2)=rlonv(imn+1) |
|---|
| 48 | |
|---|
| 49 | tmplat(1)=rlatu(1) |
|---|
| 50 | do j=2,jmn+1 |
|---|
| 51 | tmplat(j)=(rlatu(j-1)+rlatu(j))/2. |
|---|
| 52 | enddo |
|---|
| 53 | tmplat(jmn+2)=rlatu(jmn+1) |
|---|
| 54 | |
|---|
| 55 | |
|---|
| 56 | do i=1,imo |
|---|
| 57 | do j=1,jmo |
|---|
| 58 | do m=1,imn+1 |
|---|
| 59 | do n=1,jmn+1 |
|---|
| 60 | |
|---|
| 61 | if ( ((rlonuo(i) .ge. tmplon(m)) .and. |
|---|
| 62 | & (rlonuo(i) .lt. tmplon(m+1))) .and. |
|---|
| 63 | & ((rlatvo(j) .lt. tmplat(n) ) .and. |
|---|
| 64 | & (rlatvo(j) .ge. tmplat(n+1) ))) then |
|---|
| 65 | iik(i,j)=m |
|---|
| 66 | jjk(i,j)=n |
|---|
| 67 | goto 1000 |
|---|
| 68 | endif |
|---|
| 69 | |
|---|
| 70 | enddo |
|---|
| 71 | enddo |
|---|
| 72 | 1000 continue |
|---|
| 73 | enddo |
|---|
| 74 | enddo |
|---|
| 75 | |
|---|
| 76 | do m=1,imn+1 |
|---|
| 77 | do n=1,jmn+1 |
|---|
| 78 | nmesh=0 |
|---|
| 79 | do i=1,imo |
|---|
| 80 | do j=1,jmo |
|---|
| 81 | if ((iik(i,j) .eq. m) .and. (jjk(i,j) .eq. n)) then |
|---|
| 82 | outdata(m,n)=outdata(m,n)+zdata(i+imo*(j-1)) |
|---|
| 83 | nmesh=nmesh+1 |
|---|
| 84 | endif |
|---|
| 85 | |
|---|
| 86 | enddo |
|---|
| 87 | enddo |
|---|
| 88 | outdata(m,n)=outdata(m,n)/nmesh |
|---|
| 89 | enddo |
|---|
| 90 | enddo |
|---|
| 91 | |
|---|
| 92 | END SUBROUTINE avg_horiz |
|---|
| 93 | |
|---|
| 94 | END MODULE avg_horiz_mod |
|---|
