cxdef 285 linear -25.0 0.33333 cydef 181 linear 0.0 0.33333 ctdef 25 linear 12Z12dec2011 03hr czdef 24 levels 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 c 21 22 23 24 ccvars 49 include '/clima/tograds.lib/tograds.inc' character * 8 Cdate8 character * 5 ctime character * 4 clev character * 3 c3,cend,cihr character * 250 c61 dimension id7(7),ar7(7) real, ALLOCATABLE:: vau (:,:),val (:,:),z(:,:,:),z5(:,:),z7(:,:) real, ALLOCATABLE:: hgt (:,:),dl(:,:,:),sfc(:,:,:),dmsk(:,:) real, ALLOCATABLE:: dd(:,:,:),dw(:,:,:) real, ALLOCATABLE:: s8 (:,:,:,:) real, ALLOCATABLE:: aot (:,:),sfcsvi(:,:),ddsvi(:,:),dwsvi(:,:) real, ALLOCATABLE:: sfc4(:,:),dlsvi(:,:),dl4(:,:) real, ALLOCATABLE:: u10 (:,:),v10(:,:),acp(:,:) wctln(1:1) = ' ' call getarg(1,cdate8) call getarg(2,cend) call getarg(3,cihr) read (cend,*) iend read (cihr ,*) inchr read (Cdate8(1:2),'(i2)') id7(1) read (Cdate8(3:4),'(i2)') id7(2) read (Cdate8(5:6),'(i2)') id7(3) read (Cdate8(7:8),'(i2)') id7(4) c print *,' id7=',id7 call datetohr(id7(3),id7(2),id7(1),id7(4),id7(5),IHRS) call RGRADS (id7,81, 001, 0, 1, 1, 1, 0., DDD, NLRET) IMU = rnx_ctl !(1) JMU = rny_ctl !(1) NZ = nz_ctl (1) ALLOCATE(vau(IMU,JMU)) ALLOCATE(val(IMU,JMU)) ALLOCATE(hgt(IMU,JMU)) ALLOCATE(z(IMU,JMU,NZ)) ALLOCATE(s8(IMU,JMU,NZ,8)) ALLOCATE(dl(IMU,JMU,8)) ALLOCATE(sfc(IMU,JMU,8)) ALLOCATE(aot(IMU,JMU)) ALLOCATE(dd (IMU,JMU,8)) ALLOCATE(dw (IMU,JMU,8)) ALLOCATE(sfcsvi(IMU,JMU)) ALLOCATE(ddsvi (IMU,JMU)) ALLOCATE(dwsvi (IMU,JMU)) ALLOCATE(dlsvi (IMU,JMU)) ALLOCATE(sfc4(IMU,JMU)) ALLOCATE(dl4(IMU,JMU)) ALLOCATE(u10 (IMU,JMU)) ALLOCATE(v10 (IMU,JMU)) ALLOCATE(acp (IMU,JMU)) ALLOCATE(z5 (IMU,JMU)) ALLOCATE(z7 (IMU,JMU)) ALLOCATE(dmsk(IMU,JMU)) dlmdU = rxi_ctl !(1) dphdu = ryi_ctl !(1) bwU = rx0_ctl ! (1) bsU = ry0_ctl ! (1) beU = bwU + (IMU-1)*dlmdU bnU = bsU + (JMU-1)*dphdU print *,imu,"f",bwu,beu,dlmdu print *,jmu,"f",bsu,bnu,dphdu c================================= ! open (1,file="AOT.gdat",form="unformatted" open (1,file="AOT72.gdat",form="unformatted" + ,access="direct",recl=IMU*JMU) c=========================================== open (2,file="DUST.gdat",form="unformatted" ! open (2,file="DUST72.gdat",form="unformatted" + ,access="direct",recl=IMU*JMU) c================================= do 500 IHT=IHRS,IHRS+IEND,inchr c================================= JHT = IHT call hrtodate(JHT,id7(5),0,id7(3),id7(2),id7(1),id7(4)) call RGRADS (id7,07, 1, 0, IMU, JMU, 1, 0., hgt, NLRET) call RGRADS (id7,07,100,500, IMU, JMU, 1,500., z5, NLRET) call RGRADS (id7,07,100,700, IMU, JMU, 1,700., z7, NLRET) call RGRADS (id7,200,1, 0, IMU, JMU, 1, 0., dmsk, NLRET) do l=1, NZ call RGRADS (id7,7,109,l,IMU,JMU,1,1.*l,z(:,:,l), NLRET) do k=1,8 call RGRADS (id7,200+k,109,l,IMU,JMU,1,1.*l,s8(:,:,l,k),NLRET) enddo ! k enddo ! lev cdl idl=221-1 isf=211-1 idd=231-1 idw=241-1 do k=1,8 call RGRADS(id7,idl+k,1,0,IMU,JMU,1,0., dl(:,:,k), NLRET) call RGRADS(id7,isf+k,1,0,IMU,JMU,1,0., sfc(:,:,k), NLRET) call RGRADS(id7,idd+k,1,0,IMU,JMU,1,0., dd (:,:,k), NLRET) call RGRADS(id7,idw+k,1,0,IMU,JMU,1,0., dw (:,:,k), NLRET) enddo call RGRADS(id7,33,105,10,IMU,JMU,1,10.,u10, NLRET) call RGRADS(id7,34,105,10,IMU,JMU,1,10.,v10, NLRET) call RGRADS(id7,61,1,0,IMU,JMU,1,0.,acp, NLRET) cpravi aot! do j=1,jmu do i=1,imu dl(i,j,:) = 0 c z(i,j,l) je "ZMID" , u model ZIUNT na interface-u; c dl(i,j,k) = 0 zb = hgt(i,j) do l=1,nz-1 zt=0.5*(z(i,j,l)+z(i,j,l+1)) c dz = z(i,j,l)-z0 dz = zt-zb do k=1,8 dl(i,j,k)=dl(i,j,k)+dz*s8(i,j,l,k) enddo ! k zb = zt enddo enddo ! i enddo ! j aot = 0 sfcsvi = 0 ddsvi = 0 dwsvi = 0 do j=1,jmu do i=1,imu if( hgt(i,j) .lt.5000.and.hgt(i,j).ge.-200 ) then c call checkp(imu,jmu,u10,-100.,100.,und) call dl2aotxx(8, dl(i,j,1:8),aot(i,j)) sfcsvi(i,j) = sum(sfc(i,j,1:8)) dlsvi(i,j) = sum(dl(i,j,1:8)) ddsvi(i,j) = sum(dd(i,j,1:8)) dwsvi(i,j) = sum(dw(i,j,1:8)) sfc4(i,j) = sum(sfc(i,j,1:4)) dl4(i,j) = sum(dl(i,j,1:4)) endif end do end do cpisi u aot irec= ((IHT-IHRS)/inchr)*2 write(1,rec=irec+1) aot write(1,rec=irec+2) sfcsvi cpisi u dust irec= ((IHT-IHRS)/inchr)*13 !11 parametra und = -999 call checkp(imu,jmu,u10,-100.,100.,und) write(2,rec=irec+1) u10 call checkp(imu,jmu,v10,-100.,100.,und) write(2,rec=irec+2) v10 write(2,rec=irec+3) sfc4 write(2,rec=irec+4) sfcsvi write(2,rec=irec+5) dl4 write(2,rec=irec+6) dlsvi write(2,rec=irec+7) ddsvi write(2,rec=irec+8) dwsvi write(2,rec=irec+9) aot call checkp(imu,jmu,acp,-100.,10000.,und) write(2,rec=irec+10) acp call checkp(imu,jmu,z5,-100.,10000.,und) write(2,rec=irec+11) z5 call checkp(imu,jmu,z7,-100.,10000.,und) write(2,rec=irec+12) z7 write(2,rec=irec+13) dmsk 500 continue end C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& subroutine checkp(im,jm,v,bl,bu,und) dimension v(im,jm) do j=1,jm do i=1,im if( v(i,j).ge.bl.and.v(i,j).lt.bu) then else v(i,j) = und endif enddo enddo return end c================================================================== subroutine dl2aotxx(KPS,dload,aot) dimension QEXT550(8), PRADI(8),PDENS(8),dload(KPS) DATA QEXT550 /1.373,3.303,3.245,2.413,2.262,2.260,2.162,2.108/ DATA PRADI /0.15,0.25,0.45,0.78,1.32,2.24,3.80,7.11/ !microns effective DATA PDENS /2.50,2.50,2.50,2.50,2.65,2.65,2.65,2.65/ !g/cm3 aot8 = 0 do n =1, 8 spart = dload(n) aot8=aot8 + + spart * 1000*3*QEXT550(N)/(4*PRADI(N)*PDENS(N)) enddo aot = aot8 c apradi apdens aqext 2.012500 2.575000 2.390750 c print *,k,1000*spart,OTHIC550 return end