program init_vrb use dynam implicit none include 'param_o.h' include 'const.h' !!! include 'dynam_comm.h' real, dimension (:,:,:), allocatable :: pd, tg real, dimension (:,:,:,:), allocatable :: t, u, v, q real, dimension(:,:,:),allocatable::htin,uwin,vwin,mrin,sfcgrid real, dimension(:),allocatable::prin real, dimension(:,:,:,:),allocatable::hthi,uwhi,vwhi,mrhi real, dimension(:,:,:,:),allocatable::smc,stc real, dimension(:,:,:),allocatable::sm !!!!!!!! ! real,allocatable,dimension(:) :: deta, rdeta, aeta, daeta !! real,allocatable,dimension(:) :: eta, dfl ! real,allocatable,dimension(:,:,:) :: wpdar, f11, f12, f21, f22, & ! p11, p12, p21, p22, fdiv, fddmp,fvdiff & ! ,hbmsk,hsinp,hcosp !!!!!!!!! real, dimension(0:im+1,0:jm+1,nm):: sqv, sqh, rsqv, rsqh, & dxvdx, dxvdy, dyvdx, dyvdy, dzvdx, dzvdy, q11, q12, q22, & vcosp, vsinp, vlam, vphi, hlam, hphi real,dimension(:,:,:,:),allocatable::us,vs real,dimension(:,:,:,:),allocatable::sfcgridhi real,parameter::p0=1e5,ro=1.29,r=6.37122e6,om=7.292e-5 & ,u0=2*3.1415926*r/12./3600/24,grav=9.80616, & h0=2.94e4/grav,br=287.04 integer:: i,j,n,l,k real::ua,va,wa,dxadx,dyadx,dzadx,dxady,dyady,dzady,ht real,dimension(:,:,:), allocatable::fis,res integer,dimension(:,:,:),allocatable::lmh,lmv real,dimension(:,:,:,:),allocatable::htm,vtm real :: qmin !!!!!, hvmax(5),hvmin(5) real,dimension(5)::hvmax,hvmin real,dimension(lm)::f4q2 real::dfi,apel,tmp character(len=256)::init_in,init_out integer::nxin,nyin,nzin !!!!!,ihvmax(5,3),ihvmin(5,3) integer,dimension(5,3)::ihvmax,ihvmin print*,'before sveee' allocate(fis(0:im+1,0:jm+1,nm)) allocate(res(0:im+1,0:jm+1,nm)) allocate(pd(0:im+1,0:jm+1,nm)) allocate(tg(0:im+1,0:jm+1,nm)) allocate(lmh(0:im+1,0:jm+1,nm)) allocate(lmv(0:im+1,0:jm+1,nm)) allocate(htm(0:im+1,0:jm+1,nm,lm)) allocate(vtm(0:im+1,0:jm+1,nm,lm)) allocate(t(0:im+1,0:jm+1,nm,lm)) allocate(u(0:im+1,0:jm+1,nm,lm)) allocate(v(0:im+1,0:jm+1,nm,lm)) allocate(q(0:im+1,0:jm+1,nm,lm)) allocate(smc(0:im+1,0:jm+1,nm,4)) allocate(stc(0:im+1,0:jm+1,nm,4)) allocate(us(0:im+1,0:jm+1,nm,lm)) allocate(vs(0:im+1,0:jm+1,nm,lm)) allocate(sfcgridhi(0:im+1,0:jm+1,nm,14)) allocate(sm(0:im+1,0:jm+1,nm)) allocate(deta(lm)) allocate(rdeta(lm)) allocate(aeta(lm)) allocate(daeta(lm)) allocate (eta(lm+1)) allocate (dfl(lm+1)) allocate (wpdar(0:im+1,0:jm+1,nm)) allocate (f11(0:im+1,0:jm+1,nm)) allocate (f12(0:im+1,0:jm+1,nm)) allocate (f21(0:im+1,0:jm+1,nm)) allocate (f22(0:im+1,0:jm+1,nm)) allocate (p11(0:im+1,0:jm+1,nm)) allocate (p12(0:im+1,0:jm+1,nm)) allocate (p21(0:im+1,0:jm+1,nm)) allocate (p22(0:im+1,0:jm+1,nm)) allocate (fdiv(0:im+1,0:jm+1,nm)) allocate (fddmp(0:im+1,0:jm+1,nm)) allocate (fvdiff(0:im+1,0:jm+1,nm)) allocate (hbmsk(0:im+1,0:jm+1,nm)) allocate (hsinp(0:im+1,0:jm+1,nm)) allocate (hcosp(0:im+1,0:jm+1,nm)) read(5,'(a)')init_in read(5,'(a)')init_out open(unit=10,file='gridinit.dat',status='old',form="unformatted") read (10) sqv, sqh, q11, q12, q22, & dxvdx, dxvdy, dyvdx, dyvdy, dzvdx, dzvdy, & rsqv, vcosp, vsinp, vlam, vphi, & rsqh, hcosp, hsinp, hlam, hphi close(10) open(10,file='sfceta.dat',status='old',form='unformatted') read(10)fis,res,htm,vtm,lmh,lmv close(10) open(21, file='dynam.dat',status='old',form ="unformatted") read(21) fadv,fadv2, fadt, rd, f4d,f4q2, ef4t, fkin, & deta, rdeta, aeta, eta, dfl, daeta close(21) open(1,file='sm.dat',status='old',form='unformatted') read(1)sm close(1) print*,'before calls' !!!!!!!!!!1 if(.not.flat)then call read_sector_size(init_in,nxin,nyin,nzin) allocate(prin(nzin)) allocate(htin(nxin,nyin,nzin)) allocate(mrin(nxin,nyin,nzin)) allocate(uwin(nxin,nyin,nzin)) allocate(vwin(nxin,nyin,nzin)) allocate(sfcgrid(nxin,nyin,14)) print*,'pre getdata' call getdata(init_in,prin,htin,uwin,vwin,mrin,sfcgrid,nxin,nyin,nzin) allocate(hthi(0:im+1,0:jm+1,nm,nzin)) allocate(mrhi(0:im+1,0:jm+1,nm,nzin)) print*,'pre hinterp' call hinterp(htin,hthi,hlam,hphi,nxin,nyin,nzin,im,jm,nm) call hinterp(mrin,mrhi,hlam,hphi,nxin,nyin,nzin,im,jm,nm) call hinterp(sfcgrid,sfcgridhi,hlam,hphi,nxin,nyin,14,im,jm,nm) print*,'pre coastalfix' call coastalfix(sfcgridhi,sfcgrid,sm,hphi,hlam,im,jm,nm,nxin,nyin) deallocate(htin) deallocate(mrin) allocate(uwhi(0:im+1,0:jm+1,nm,nzin)) allocate(vwhi(0:im+1,0:jm+1,nm,nzin)) call hinterp(uwin,uwhi,vlam,vphi,nxin,nyin,nzin,im,jm,nm) call hinterp(vwin,vwhi,vlam,vphi,nxin,nyin,nzin,im,jm,nm) deallocate(uwin) deallocate(vwin) deallocate(sfcgrid) if(sigma)then call pusi(prin,hthi,mrhi,uwhi,vwhi,nzin,pd,t,q,us,vs,fis,im,jm,nm,lm) else call vinterp(prin,hthi,mrhi,uwhi,vwhi,nzin,pd,t,q,us,vs,im,jm,nm,lm) endif deallocate(prin,hthi,uwhi,vwhi) print*,'posle vinterp' !!!!!!!!!!!!!! do n=1,nm do i=1,im-1 do j=1,jm-1 do l=1,lm ua=-vsinp(i,j,n)*cos(vlam(i,j,n))*vs(i,j,n,l) & - sin(vlam(i,j,n))*us(i,j,n,l) va=-vsinp(i,j,n)*sin(vlam(i,j,n))*vs(i,j,n,l) & + cos(vlam(i,j,n))*us(i,j,n,l) wa=vcosp(i,j,n)*vs(i,j,n,l) dxadx=dxvdx(i,j,n) dyadx=dyvdx(i,j,n) dzadx=dzvdx(i,j,n) dxady=dxvdy(i,j,n) dyady=dyvdy(i,j,n) dzady=dzvdy(i,j,n) u(i,j,n,l)=ua*dxadx+va*dyadx+wa*dzadx v(i,j,n,l)=ua*dxady+va*dyady+wa*dzady end do end do end do end do do n=1,nm do i=1,im do j=1,jm ! do i=0,im+1 !%%%%%%%%%% do j=0,jm+1 tg(i,j,n)=amax1(sfcgridhi(i,j,n,11),273.15) enddo enddo enddo else pd=p0 t=290 u=0 v=0 tg=290 endif call bocoh(pd,im,jm,nm) call bocoh(fis,im,jm,nm) call bocoh(tg,im,jm,nm) do l=lm,1,-1 call bocoh(t(:,:,:,l),im,jm,nm) call bocoh(q(:,:,:,l),im,jm,nm) enddo open(1,file='sfcgrid.dat',form="unformatted") write(1)sfcgridhi close(1) do k=1,4 smc(:,:,:,k)=sfcgridhi(:,:,:,2*k+4) stc(:,:,:,k)=sfcgridhi(:,:,:,2*k+3) enddo call sfceta2(sm,hlam,hphi,sfcgridhi,smc,stc,im,jm,nm) do n=1,nm do i=1,im do j=1,jm !%%%%%%%%%% do i=0,im+1 ! do j=0,jm+1 if(smc(i,j,n,1).eq.0.and.sm(i,j,n).eq.0)then smc(i,j,n,:)=0.14 stc(i,j,n,:)=271. else if(sm(i,j,n).eq.1)then do k=1,4 stc(i,j,n,k)=amax1(273.15,stc(i,j,n,k)) enddo endif enddo enddo enddo hvmax=-1.e10 hvmin=1.e10 do n=1,nm do i=1,im do j=1,jm if(hvmax(2).lt.pd(i,j,n))then ihvmax(2,1)=i ihvmax(2,2)=j ihvmax(2,3)=n hvmax(2)=pd(i,j,n) endif if(hvmin(2).gt.pd(i,j,n))then ihvmin(2,1)=i ihvmin(2,2)=j ihvmin(2,3)=n hvmin(2)=pd(i,j,n) endif enddo enddo enddo print *,'max pd,i,j,n,',hvmax(2),ihvmax(2,:) print *,'min pd,i,j,n,',hvmin(2),ihvmin(2,:) open(10,file='init_out.dat',form ='unformatted') write(10)pd,t,q,u,v,tg,smc,stc close(10) open(10,file='sfceta.dat',form='unformatted') write(10)fis,res,htm,vtm,lmh,lmv close(10) open(10,file='f3.dat',form='unformatted') write(10)fis(:,:,3) close(10) end program init_vrb