29 |
c ---------- |
c ---------- |
30 |
integer mode |
integer mode |
31 |
real masse(ip1jmp1,llm) |
real masse(ip1jmp1,llm) |
32 |
REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm) |
REAL, intent(in):: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm) |
33 |
REAL q(ip1jmp1,llm) |
REAL q(ip1jmp1,llm) |
34 |
REAL w(ip1jmp1,llm),pdt |
REAL w(ip1jmp1,llm),pdt |
35 |
c |
c |
509 |
do l=1,llm |
do l=1,llm |
510 |
do ij=iip2,ip1jm |
do ij=iip2,ip1jm |
511 |
zdq=qd(ij,l)-qg(ij,l) |
zdq=qd(ij,l)-qg(ij,l) |
|
c if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) then |
|
|
c print*,'probleme au point ij=',ij,' l=',l |
|
|
c print*,qd(ij,l),q(ij,l),qg(ij,l) |
|
|
c qd(ij,l)=q(ij,l) |
|
|
c qg(ij,l)=q(ij,l) |
|
|
c endif |
|
512 |
if(abs(zdq).gt.prec) then |
if(abs(zdq).gt.prec) then |
513 |
zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq |
zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq |
514 |
zsigg(ij,l)=1.-zsigd(ij,l) |
zsigg(ij,l)=1.-zsigd(ij,l) |
|
c if(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and. |
|
|
c s zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) then |
|
|
c print*,'probleme au point ij=',ij,' l=',l |
|
|
c print*,'sigg=',zsigg(ij,l),' sigd=',zsigd(ij,l) |
|
|
c print*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq |
|
|
c stop |
|
|
c endif |
|
515 |
else |
else |
516 |
zsigd(ij,l)=0.5 |
zsigd(ij,l)=0.5 |
517 |
zsigg(ij,l)=0.5 |
zsigg(ij,l)=0.5 |
560 |
s +(zsig-zsigp)*(zq+zz*(zqm-zq)) ) |
s +(zsig-zsigp)*(zq+zz*(zqm-zq)) ) |
561 |
endif |
endif |
562 |
endif |
endif |
|
c if(zsig.lt.0.) then |
|
|
c print*,'au point ij=',ij,' l=',l,' sig=',zsig |
|
|
c stop |
|
|
c endif |
|
563 |
enddo |
enddo |
564 |
enddo |
enddo |
565 |
|
|
587 |
enddo |
enddo |
588 |
|
|
589 |
if(n0.gt.1) then |
if(n0.gt.1) then |
590 |
IF (prt_level > 9) WRITE(lunout,*) |
IF (prt_level > 9) print *, |
591 |
& 'Nombre de points pour lesquels on advect plus que le' |
& 'Nombre de points pour lesquels on advect plus que le' |
592 |
& ,'contenu de la maille : ',n0 |
& ,'contenu de la maille : ',n0 |
593 |
|
|
602 |
endif |
endif |
603 |
enddo |
enddo |
604 |
niju=iju |
niju=iju |
|
c print*,'niju,nl',niju,nl(l) |
|
605 |
|
|
606 |
c traitement des mailles |
c traitement des mailles |
607 |
do iju=1,niju |
do iju=1,niju |
630 |
c goto 8888 |
c goto 8888 |
631 |
zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l) |
zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l) |
632 |
if(.not.(zz.gt.0..and.zz.le.0.5)) then |
if(.not.(zz.gt.0..and.zz.le.0.5)) then |
633 |
WRITE(lunout,*)'probleme2 au point ij=',ij, |
print *,'probleme2 au point ij=',ij, |
634 |
s ' l=',l |
s ' l=',l |
635 |
WRITE(lunout,*)'zz=',zz |
print *,'zz=',zz |
636 |
stop |
stop |
637 |
endif |
endif |
638 |
u_mq(ij,l)=u_mq(ij,l)+masse(ijq,l)*( |
u_mq(ij,l)=u_mq(ij,l)+masse(ijq,l)*( |
660 |
c goto 9999 |
c goto 9999 |
661 |
zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l) |
zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l) |
662 |
if(.not.(zz.gt.0..and.zz.le.0.5)) then |
if(.not.(zz.gt.0..and.zz.le.0.5)) then |
663 |
WRITE(lunout,*)'probleme22 au point ij=',ij |
print *,'probleme22 au point ij=',ij |
664 |
s ,' l=',l |
s ,' l=',l |
665 |
WRITE(lunout,*)'zz=',zz |
print *,'zz=',zz |
666 |
stop |
stop |
667 |
endif |
endif |
668 |
u_mq(ij,l)=u_mq(ij,l)-masse(ijq,l)*( |
u_mq(ij,l)=u_mq(ij,l)-masse(ijq,l)*( |
748 |
do l=1,llm |
do l=1,llm |
749 |
do ij=1,ip1jmp1 |
do ij=1,ip1jmp1 |
750 |
zdq=qn(ij,l)-qs(ij,l) |
zdq=qn(ij,l)-qs(ij,l) |
|
c if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) then |
|
|
c print*,'probleme au point ij=',ij,' l=',l,' advnqx' |
|
|
c print*,qn(ij,l),q(ij,l),qs(ij,l) |
|
|
c qn(ij,l)=q(ij,l) |
|
|
c qs(ij,l)=q(ij,l) |
|
|
c endif |
|
751 |
if(abs(zdq).gt.prec) then |
if(abs(zdq).gt.prec) then |
752 |
zsign(ij)=(q(ij,l)-qs(ij,l))/zdq |
zsign(ij)=(q(ij,l)-qs(ij,l))/zdq |
753 |
zsigs(ij)=1.-zsign(ij) |
zsigs(ij)=1.-zsign(ij) |
|
c if(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and. |
|
|
c s zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) then |
|
|
c print*,'probleme au point ij=',ij,' l=',l |
|
|
c print*,'sigs=',zsigs(ij),' sign=',zsign(ij) |
|
|
c stop |
|
|
c endif |
|
754 |
else |
else |
755 |
zsign(ij)=0.5 |
zsign(ij)=0.5 |
756 |
zsigs(ij)=0.5 |
zsigs(ij)=0.5 |
863 |
do l=1,llm |
do l=1,llm |
864 |
do ij=1,ip1jmp1 |
do ij=1,ip1jmp1 |
865 |
zdq=qb(ij,l)-qh(ij,l) |
zdq=qb(ij,l)-qh(ij,l) |
|
c if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) then |
|
|
c print*,'probleme au point ij=',ij,' l=',l |
|
|
c print*,qh(ij,l),q(ij,l),qb(ij,l) |
|
|
c qh(ij,l)=q(ij,l) |
|
|
c qb(ij,l)=q(ij,l) |
|
|
c endif |
|
|
|
|
866 |
if(abs(zdq).gt.prec) then |
if(abs(zdq).gt.prec) then |
867 |
zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq |
zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq |
868 |
zsigh(ij,l)=1.-zsigb(ij,l) |
zsigh(ij,l)=1.-zsigb(ij,l) |
874 |
enddo |
enddo |
875 |
enddo |
enddo |
876 |
|
|
|
c print*,'ok1' |
|
877 |
c calcul de la pente maximum dans la maille en valeur absolue |
c calcul de la pente maximum dans la maille en valeur absolue |
878 |
do l=2,llm |
do l=2,llm |
879 |
do ij=1,ip1jmp1 |
do ij=1,ip1jmp1 |
917 |
masse(ij,l)=new_m |
masse(ij,l)=new_m |
918 |
enddo |
enddo |
919 |
enddo |
enddo |
920 |
c print*,'ok3' |
|
|
RETURN |
|
921 |
END |
END |