384 |
ENDDO |
ENDDO |
385 |
ENDDO |
ENDDO |
386 |
|
|
|
|
|
387 |
DO i = 1, imar |
DO i = 1, imar |
388 |
DO j = 1, jmar |
DO j = 1, jmar |
389 |
IF (num_tot(i,j) .GT. 0.001) THEN |
IF (num_tot(i,j) .GT. 0.001) THEN |
465 |
ENDDO |
ENDDO |
466 |
ENDDO |
ENDDO |
467 |
|
|
|
|
|
468 |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
469 |
|
|
470 |
DO ii = 1, imar |
DO ii = 1, imar |
584 |
ENDDO |
ENDDO |
585 |
ENDDO |
ENDDO |
586 |
|
|
|
|
|
587 |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
588 |
|
|
589 |
DO ii = 1, imar |
DO ii = 1, imar |
606 |
ENDDO |
ENDDO |
607 |
ENDDO |
ENDDO |
608 |
|
|
|
|
|
609 |
DO i = 1, imar |
DO i = 1, imar |
610 |
DO j = 1, jmar |
DO j = 1, jmar |
611 |
IF (num_tot(i,j) .GT. 0.001) THEN |
IF (num_tot(i,j) .GT. 0.001) THEN |
645 |
|
|
646 |
SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief, immod, jmmod, xmod, & |
SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief, immod, jmmod, xmod, & |
647 |
ymod, rugs) |
ymod, rugs) |
|
!======================================================================= |
|
|
! Calculer la longueur de rugosite liee au relief en utilisant |
|
|
! l'ecart-type dans une maille de 1x1 |
|
|
!======================================================================= |
|
|
|
|
|
REAL zzmin |
|
648 |
|
|
649 |
REAL amin, AMAX |
! Calcule la longueur de rugosite liee au relief en utilisant |
650 |
|
! l'ecart-type dans une maille de 1x1. |
651 |
|
|
652 |
INTEGER, intent(in):: imrel, jmrel |
INTEGER, intent(in):: imrel, jmrel |
653 |
REAL, intent(in):: xrel(imrel),yrel(jmrel) |
REAL, intent(in):: xrel(imrel),yrel(jmrel) |
657 |
REAL, intent(in):: xmod(immod),ymod(jmmod) |
REAL, intent(in):: xmod(immod),ymod(jmmod) |
658 |
REAL, intent(out):: rugs(immod,jmmod) |
REAL, intent(out):: rugs(immod,jmmod) |
659 |
|
|
660 |
|
REAL zzmin |
661 |
|
REAL amin, AMAX |
662 |
INTEGER imtmp, jmtmp |
INTEGER imtmp, jmtmp |
663 |
PARAMETER (imtmp=360,jmtmp=180) |
PARAMETER (imtmp=360,jmtmp=180) |
664 |
REAL xtmp(imtmp), ytmp(jmtmp) |
REAL xtmp(imtmp), ytmp(jmtmp) |
672 |
REAL distans(400*400) |
REAL distans(400*400) |
673 |
INTEGER i_proche, j_proche, ij_proche |
INTEGER i_proche, j_proche, ij_proche |
674 |
|
|
675 |
|
!--------------------------------------------------------- |
676 |
|
|
677 |
IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN |
IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN |
678 |
PRINT*, 'immod ou jmmod trop grand', immod, jmmod |
PRINT*, 'immod ou jmmod trop grand', immod, jmmod |
679 |
STOP 1 |
STOP 1 |
717 |
DO i = 1, imtmp |
DO i = 1, imtmp |
718 |
DO j = 1, jmtmp |
DO j = 1, jmtmp |
719 |
number(i,j) = 0.0 |
number(i,j) = 0.0 |
720 |
cham1tmp(i,j) = 0.0 |
cham1tmp(i,j) = 0d0 |
721 |
cham2tmp(i,j) = 0.0 |
cham2tmp(i,j) = 0d0 |
722 |
ENDDO |
ENDDO |
723 |
ENDDO |
ENDDO |
724 |
|
|
|
|
|
725 |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
! ..... Modif P. Le Van ( 23/08/95 ) .... |
726 |
|
|
727 |
DO ii = 1, imtmp |
DO ii = 1, imtmp |
738 |
number(ii,jj) = number(ii,jj) + 1.0 |
number(ii,jj) = number(ii,jj) + 1.0 |
739 |
cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j) |
cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j) |
740 |
cham2tmp(ii,jj) = cham2tmp(ii,jj) & |
cham2tmp(ii,jj) = cham2tmp(ii,jj) & |
741 |
+ relief(i,j)*relief(i,j) |
+ relief(i,j) * relief(i,j) |
742 |
ENDIF |
ENDIF |
743 |
ENDDO |
ENDDO |
744 |
ENDIF |
ENDIF |
751 |
IF (number(i,j) .GT. 0.001) THEN |
IF (number(i,j) .GT. 0.001) THEN |
752 |
cham1tmp(i,j) = cham1tmp(i,j) / number(i,j) |
cham1tmp(i,j) = cham1tmp(i,j) / number(i,j) |
753 |
cham2tmp(i,j) = cham2tmp(i,j) / number(i,j) |
cham2tmp(i,j) = cham2tmp(i,j) / number(i,j) |
754 |
zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2 |
zzzz = cham2tmp(i,j) - cham1tmp(i,j)**2 |
755 |
if (zzzz .lt. 0.0) then |
if (zzzz .lt. 0.0) then |
756 |
if (zzzz .gt. -7.5) then |
if (zzzz .gt. -7.5) then |
757 |
zzzz = 0.0 |
zzzz = 0.0 |
778 |
ENDDO |
ENDDO |
779 |
PRINT*, 'Ecart-type 1x1:', amin, AMAX |
PRINT*, 'Ecart-type 1x1:', amin, AMAX |
780 |
|
|
|
|
|
781 |
a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0 |
a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0 |
782 |
b(1) = (xmod(1)+xmod(2))/2.0 |
b(1) = (xmod(1)+xmod(2))/2.0 |
783 |
DO i = 2, immod-1 |
DO i = 2, immod-1 |
803 |
ENDDO |
ENDDO |
804 |
ENDDO |
ENDDO |
805 |
|
|
|
|
|
|
! ..... Modif P. Le Van ( 23/08/95 ) .... |
|
|
|
|
806 |
DO ii = 1, immod |
DO ii = 1, immod |
807 |
DO jj = 1, jmmod |
DO jj = 1, jmmod |
808 |
DO i = 1, imtmp |
DO i = 1, imtmp |