*=*=*=*= initestdyn.html =*=*=*=*
PROGRAM initestdyn IMPLICIT NONE c======================================================================= c c creation d'un etat initial c c======================================================================= c c----------------------------------------------------------------------- c declarations: c ------------- #include "dimensions.h" INTEGER ngridmx PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm ) c----------------------------------------------------------------------- #include "paramet.h" #include "comconst.h" #include "comvert.h" #include "comgeom2.h" #include "control.h" #include "logic.h" #include "drsdef.h" c REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) REAL h(iip1,jjp1,llm),pext(iip1,jjp1) REAL pks(iip1,jjp1),pksf(iip1,jjp1) REAL phis(iip1,jjp1),q REAL z_reel(iip1,jjp1),rnatur(iip1,jjp1) REAL phisfi(ngridmx),rnaturfi(ngridmx) REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx) c INTEGER i,j,l,itau,ig,idum INTEGER*4 day0 INTEGER unit REAL p(iip1,jjp1),phis0,zz REAL t(iip1,jjp1,llm) REAL phi(iip1,jjp1,llm) REAL etot0,ptot0,ztot0,stot0,ang0,xx REAL daydeb,pressrf REAL href(llm),pref(llm),phiref(llm),pksref,pfact REAL pmer,airmer INTEGER ijmin,imin,jmin EXTERNAL RAN1 REAL RAN1 EXTERNAL iniconst,geopot,inigeom INTEGER aslun, cllun INTEGER ierr, nbetat INTEGER ISMIN external ISMIN CHARACTER*80 file c c----------------------------------------------------------------------- c initialisations: c ---------------- c rad=6400000. omeg=4.*asin(1.)/(24.*3600.) g=9.8 mugaz=28. kappa=.2857 day_step=180 daysec=86400. c----------------------------------------------------------------------- OPEN(99,file='run.def',status='old',form='formatted') CALL defrun(99) CLOSE (99) CALL iniconst CALL inigeom PRINT*,'dtvr ',dtvr idum=-1 xx=RAN1(idum) idum=0 c----------------------------------------------------------------------- latfi(1)=rlatu(1) lonfi(1)=0. DO j=2,jjm DO i=1,iim latfi((j-2)*iim+1+i)=rlatu(j) lonfi((j-2)*iim+1+i)=rlonv(i) ENDDO ENDDO latfi(ngridmx)=rlatu(jjp1) lonfi(ngridmx)=0. CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi) c----------------------------------------------------------------------- c lecture d'un fichier d'altitudes terrestre: c ------------------------------------------- DO j=1,jjp1 DO i=1,iip1 rnatur(i,j)=0. phis(i,j)=0. ENDDO ENDDO CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,rnatur,rnaturfi) CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi) CALL ini_fi(ngridmx,llm, $ 0.,0., $ daysec, $ 0,0., $ latfi,lonfi,airefi,phisfi,rnaturfi, $ rad,g,r,cpp,285.) c DO 103 l=1,llm DO 104 j=1,jjp1 DO 105 i=1,iim t(i,j,l)=285. 105 CONTINUE 104 CONTINUE c DO j=2,jjm c DO i=1,iim c t(i,j,l)=t(i,j,l)+COS(rlatu(j))*(RAN1(idum)-0.5) c ENDDO c ENDDO DO 108 j=1,jjp1 t(iip1,j,l)=t(1,j,l) 108 CONTINUE 103 CONTINUE c c CALCUL DE L'EQUILIBRE HYDROSTATIQUE GLOBAL c DO j=1,jjp1 DO i=1,iim pext(i,j)=1013.*aire(i,j) ENDDO ENDDO CALL SCOPY(jjp1,pext,iip1,pext(iip1,1),iip1) CALL multipl(ip1jmp1,pext,unsaire,p) CALL uniplot(iip1,jjp1,p) CALL dump2d(iip1,jjp1,p,'pression naturelle au sol') PRINT*,imin,jmin c----------------------------------------------------------------------- c On calcul h,ts,pks,pksf,pext: c ----------------------------- c DO l=1,llm DO j=1,jjp1 DO i=1,iip1 h(i,j,l) = t(i,j,l)*cpp/(s(l)*p(i,j)**kappa) ENDDO ENDDO ENDDO c DO j=1,jjp1 DO i=1,iip1 pks(i,j) =p(i,j)**kappa pksf(i,j)=pks(i,j) ENDDO ENDDO c c----------------------------------------------------------------------- c calcul des champ de vent: c ------------------------- c DO l=1,llm DO i=1,iip1 ucov(i,1,l)=0. ucov(i,jjp1,l)=0. ENDDO DO j=2,jjm DO i=1,iim ucov(i,j,l) = 0. ENDDO ucov(iip1,j,l)=ucov(1,j,l) ENDDO ENDDO c DO l=1,llm DO j=1,jjm DO i=1,iim vcov(i,j,l) = 0. ENDDO vcov(iip1,j,l)=vcov(1,j,l) ENDDO ENDDO c----------------------------------------------------------------------- c ecriture du fichier de demarage: c -------------------------------- c etot0=0. ptot0=0. stot0=0. ztot0=0. ang0=0. daysec=86400. unit=12 ierr = aslun(unit,'start.dic', . unit+1,'start.dat',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier restart' write(6,*)' ierr = ', ierr call exit(1) endif day0=0 CALL iniwrite(unit,day0,phis) zz=0. call writedem(unit,nqmx,zz,vcov,ucov,h,q,pext, . phis,nbetat) ierr = cllun(unit) end