You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
193 lines
4.9 KiB
Fortran
193 lines
4.9 KiB
Fortran
PROGRAM creatgrid
|
|
dimension XL(100,2),YL(100,2),mappt(2),XL1(100),XL2(100)
|
|
REAL*8 GRIDX(100),GRIDY(100)
|
|
!
|
|
! define line numbers in map file
|
|
!
|
|
DIST(A,B,C,D)=SQRT((C-A)*2+(D-C)**2)
|
|
XL(1,1)=0.
|
|
XL(2,1)=320.
|
|
XL(3,1)=530.
|
|
YL(1,1)=0.
|
|
YL(2,1)=20.
|
|
YL(3,1)=50.
|
|
MAPPT(1)=3
|
|
XL(1,2)=0.
|
|
XL(2,2)=600.
|
|
YL(1,2)=70.
|
|
YL(2,2)=90.
|
|
MAPPT(2)=2
|
|
K1=1
|
|
K2=2
|
|
|
|
!
|
|
! compute line length
|
|
!
|
|
XL1=0.
|
|
nlpts1=mappt(k1)
|
|
do n=2,nlpts1
|
|
XL1(n)=XL1(n-1)+dist(XL(n-1,1),YL(n-1,1),XL(n,1),YL(n,1))
|
|
enddo
|
|
XL2=0.
|
|
nlpts2=mappt(k2)
|
|
do n=2,nlpts2
|
|
XL2(n)=XL2(n-1)+dist(XL(n-1,2),YL(n-1,2),XL(n,2),YL(n,2))
|
|
enddo
|
|
xmean=(XL1(nlpts1)+XL2(nlpts2))/2.
|
|
!
|
|
! get size spacing
|
|
!
|
|
! read xsz,NY
|
|
XSZ=100.
|
|
NY=5
|
|
along=xmean/xsz
|
|
NX=(along+0.99)
|
|
|
|
NXP=NX+1
|
|
NYP=NY+1
|
|
NRL=NX*NYP+1
|
|
NRT=NXP*NYP
|
|
|
|
! DO N=1,NE
|
|
! DO M=1,8
|
|
! NOPSV(N,M)=NOP(N,M)
|
|
! ENDDO
|
|
! IMATSV(N)=IMAT(N)
|
|
! ENDDO
|
|
! NESAV=NE
|
|
! NEFSAV=NENTRY
|
|
! NPUNDO=NRT
|
|
!
|
|
! Initialize GRIDX and GRIDY
|
|
!
|
|
DO N=1,NRT
|
|
GRIDX(N)=0.
|
|
GRIDY(N)=0.
|
|
! IGSKP(N)=0
|
|
END DO
|
|
!
|
|
! calculate lengths
|
|
!
|
|
xalong1=XL1(nlpts1)/NX
|
|
xalong2=XL2(nlpts2)/NX
|
|
!
|
|
! compute cords along the edges
|
|
!
|
|
XALONG=0.
|
|
XXALONG=0.
|
|
GRIDX(1)=XL(1,1)
|
|
GRIDY(1)=YL(1,1)
|
|
GRIDX(NYP)=XL(1,2)
|
|
GRIDY(NYP)=YL(1,2)
|
|
NRT=NXP*NYP
|
|
DO N=NY+2,NRT,NYP
|
|
XALONG=XALONG+XALONG1
|
|
NX1=2
|
|
DO M=NX1,NLPTS1
|
|
IF(XALONG .LT. XL1(M)) THEN
|
|
M1=M
|
|
GO TO 200
|
|
ENDIF
|
|
ENDDO
|
|
200 CONTINUE
|
|
FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
|
|
GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
|
|
GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
|
|
NX1=M1
|
|
XXALONG=XXALONG+XALONG2
|
|
NX2=2
|
|
DO M=NX2,NLPTS2
|
|
IF(XXALONG .LT. XL2(M)) THEN
|
|
M2=M
|
|
GO TO 250
|
|
ENDIF
|
|
ENDDO
|
|
250 CONTINUE
|
|
FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
|
|
GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
|
|
GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
|
|
NX2=M2
|
|
ENDDO
|
|
!
|
|
!
|
|
! check if points ok allow for move
|
|
!
|
|
!
|
|
! form elements and other coordinates
|
|
!
|
|
!
|
|
! Interpolate interior points
|
|
!
|
|
DO M=1,NRT,NYP
|
|
NFS=NRL+M-1
|
|
CALL INTERP(GRIDX,GRIDY,M,M+NY,1,GRIDX(M),GRIDY(M),GRIDX(M+NY) &
|
|
& ,GRIDY(M+NY),NY,0)
|
|
! DO N=M,NFS
|
|
! XTEMP=GRIDX(N)
|
|
! YTEMP=GRIDY(N)
|
|
! GRIDXL(N) = GRIDX(N)*TXSCAL - XS
|
|
! GRIDYL(N) = GRIDY(N)*TXSCAL - YS
|
|
! CALL RRed
|
|
! call drawcr(xtemp,ytemp,siz)
|
|
! CALL RBlue
|
|
! ENDDO
|
|
END DO
|
|
!
|
|
! query for depths
|
|
!
|
|
!
|
|
! query for happY
|
|
STOP
|
|
end
|
|
SUBROUTINE INTERP(GRIDX,GRIDY,NL,NH,INT,ALX,ALY,ATX,ATY,NINT,ISWT)
|
|
!
|
|
! Routine to fill GRIDX and GRIDY by interpolation
|
|
! NL = START OF GENERATED
|
|
! NH = END OF GENERATED
|
|
! INT = INTERVAL
|
|
! ALX, ALY = START LOC
|
|
! ATX, ATY = END LOC
|
|
! NINT = NUMBER OF POINTS
|
|
! ISWT = 0 BASELINE = 1 APPLY CHANGES
|
|
!IPK MAY02
|
|
REAL*8 GRIDX(NH),GRIDY(NH),ALX,ALY,ATX,ATY
|
|
!
|
|
! Compute intervals
|
|
!
|
|
XINT=(ATX-ALX)/FLOAT(NINT)
|
|
YINT=(ATY-ALY)/FLOAT(NINT)
|
|
!
|
|
! Generate points
|
|
!
|
|
IF(ISWT .EQ. 0) THEN
|
|
KP=0
|
|
DO 200 K=NL,NH,INT
|
|
IF(KP .EQ. 0) THEN
|
|
GRIDX(K)=ALX
|
|
GRIDY(K)=ALY
|
|
ELSE
|
|
GRIDX(K)=GRIDX(KP)+XINT
|
|
GRIDY(K)=GRIDY(KP)+YINT
|
|
ENDIF
|
|
KP=K
|
|
200 CONTINUE
|
|
ELSE
|
|
XAD=ALX
|
|
YAD=ALY
|
|
KP=0
|
|
DO 220 K=NL,NH,INT
|
|
IF(KP .EQ. 0) THEN
|
|
GRIDX(K)=GRIDX(K)+XAD
|
|
GRIDY(K)=GRIDY(K)+YAD
|
|
ELSE
|
|
XAD=XAD+XINT
|
|
YAD=YAD+YINT
|
|
GRIDX(K)=GRIDX(K)+XAD
|
|
GRIDY(K)=GRIDY(K)+YAD
|
|
ENDIF
|
|
KP=K
|
|
220 CONTINUE
|
|
ENDIF
|
|
RETURN
|
|
END
|
|
|