*=*=*=*= disvert.html =*=*=*=*
SUBROUTINE disvert(llm,kappa,sig,dsig,s,ds,dsig1,sdsig) IMPLICIT NONE c c======================================================================= c c c s = sigma ** kappa : coordonnee verticale c dsig(l) : epaisseur de la couche l ds la coord. s c sig(l) : sigma a l'interface des couches l et l-1 c ds(l) : distance entre les couches l et l-1 en coord.s c c======================================================================= c c declarations: c ------------- c integer llm real kappa,pi,x real sig(llm+1),dsig(llm),s(llm),ds(llm),dsig1(llm),sdsig(llm) c integer ll,l,lllm,lllmm1,lllmp1 real abid,abid2,som,quoi,quand,snorm,sigbid,sbid REAL alpha,beta,h,zd,dz0,dz1 REAL gama,delta,deltaz,np real nhaut INTEGER ierr,ierr1,ierr2 real puiss real asig,bsig,csig,esig,zsig,p,zz,sig1 REAL SSUM,z1,z2 EXTERNAL SSUM c c----------------------------------------------------------------------- c lllm=llm lllmm1=lllm-1 lllmp1=lllm+1 pi=2.*asin(1.) OPEN(99,file='sigma.def',status='old',form='formatted', s iostat=ierr1) if(ierr1.ne.0) then close(99) open(99,file='esasig.def',status='old',form='formatted', s iostat=ierr2) endif c----------------------------------------------------------------------- c cas 1 on lit les options dans sigma.def: c ---------------------------------------- if (ierr1.eq.0) then PRINT*,'WARNING Lecture de sigma.def' READ(99,*) deltaz READ(99,*) h READ(99,*) beta READ(99,*) gama READ(99,*) delta READ(99,*) np CLOSE(99) alpha=deltaz/(llm*h) do l= 1, llm dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))* $ ( (tanh(gama*l)/tanh(gama*llm))**np + $ (1.-l/FLOAT(llm))*delta ) enddo sig(1)=1. do l=1,llm-1 sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l)) enddo sig(llm+1)=0. do l = 1, llm dsig(l) = sig(l)-sig(l+1) enddo else if(ierr2.eq.0) then PRINT*,'WARNING Lecture de esasig.def' READ(99,*) h READ(99,*) dz0 READ(99,*) dz1 READ(99,*) nhaut CLOSE(99) dz0=dz0/h dz1=dz1/h sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut) esig=1. PRINT* do l=1,20 print*,'esig=',esig esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.) enddo PRINT* csig=(1./sig1-1.)/(exp(esig)-1.) DO L = 2, llm zz=csig*(exp(esig*(l-1.))-1.) sig(l) =1./(1.+zz) & * tanh(.5*(llm+1-l)/nhaut) ENDDO sig(1)=1. sig(llm+1)=0. do l = 1, llm dsig(l) =sig(l)-sig(l+1) enddo else print*,'WARNING!!! Ancienne discretisation verticale' stop h=7. snorm = 0. do l = 1, llm x = 2.*asin(1.) * (float(l)-0.5) / float(llm+1) dsig(l) = 1.0 + 7.0 * sin(x)**2 snorm = snorm + dsig(l) enddo snorm = 1./snorm do l = 1, llm dsig(l) = dsig(l)*snorm enddo sig(llm+1) = 0. do l = llm, 1, -1 sig(l) = sig(l+1) + dsig(l) enddo endif c----------------------------------------------------------------------- c calcul de s, ds, sdsig... c ------------------------- quoi = 1. + 2.* kappa s( llm ) = 1. s(lllmm1) = quoi IF( llm.gt.2 ) THEN DO ll = 2, lllmm1 l = lllmp1 - ll quand = sig(l+1)/ sig(l) s(l-1) = quoi * (1.-quand) * s(l) + quand * s(l+1) ENDDO END IF c snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2) DO l = 1, llm s(l) = s(l)/ snorm ENDDO DO l = 2, llm ds(l) = s(l-1) - s(l) ENDDO ds(1) = 1. - s(1) c DO l = 1, llm sdsig(l) = s(l) * dsig(l) dsig1(l)= 1./dsig(l) ENDDO c----------------------------------------------------------------------- c c Diagnostique sur la discretisation verticale: c --------------------------------------------- c print*,'Diagnostique de la discretisation verticale' print* print*,'comparaison de sig(l) et (s(l)+s(l+1))/2)**(1/K)' do 14 l=1,llm-1 sigbid=(0.5*(s(l)+s(l+1)))**(1./kappa) print*,'sig(',l+1,') = ',sig(l+1), S ' valeur approchee :',sigbid,' ',dsig(l) 14 continue print* print*,'comparaison de s(l) et (sig(l)+sig(l+1))/2)**K' do 15 l=1,llm sbid=(0.5*(sig(l+1)+sig(l)))**kappa print*,' s(',l,') = ',s(l), S ' valeur approchee :',sbid 15 continue c PRINT*,'Altitude approchee z,dz' PRINT* z1=0. print*,' l Z DZ Ztop dsig' DO 18 l=1,llm-1 z2=-h*log(sig(l+1)) write(*,'(i5,3x,4f8.4)') l,-h*log(s(l))/kappa,z2-z1,z2 & ,dsig(l) write(14,'(3x,i5,1f10.4)') l,-h*log(s(l))/kappa z1=z2 18 CONTINUE write(*,'(i5,3x,3f8.4)') l,-h*log(s(llm))/kappa write(14,'(3x,i5,1f10.4)') l,-h*log(s(llm))/kappa Chris DEBUT Sortie speciale PRINT*,'********************************' PRINT*,' sig Z dZ' z1=0. l=1 write(*,'(i2,2f12.8)') l,sig(l),z1 do 19 l=1,llm-1 z2=-h*log(sig(l+1)) write(*,'(i2,3f12.8)') l+1,sig(l+1),z2,z2-z1 z1=z2 19 continue PRINT*,'********************************' Chris FIN Sortie speciale c----------------------------------------------------------------------- RETURN END