PROGRAM SET4IMP1 C======================================================================= C DATA GENERATING PROGRAM FOR IMP4Q.FOR C PROJECT: CONFINED GROUNDWATER PROJECT NAME: IMP4DATA.QQQ C DOMAIN: C ELEMENT: FOUR-NODED ISOPARAMETRIC ELEMENT C DOMAIN DISCRETIZATION: UNEVEN ELEMENTS WITH VERTICAL SCAN C EIJI FUKUMORI DECEMBER 29, 1993 C FEBRUARY 05, 2013 C======================================================================= IMPLICIT REAL*8 ( A-H , O-Z ) PARAMETER ( ND=4, MXE=20000, MXN=30000, MXB=3000 ) PARAMETER ( HEIGHT=1.D0, TLX = HEIGHT,TLY = HEIGHT, * NEY = 20, NEX = 20, DX = TLX / NEX, DY = TLY / NEY,WAVEH=1., * ALPHA=100.D0, NDX=NEX+1,NDY=NEY+1) PARAMETER ( INTEPT=2 ) C======================================================================= DIMENSION NODEX(MXE,ND),XCOORD(MXN), YCOORD(MXN),IBNDF(MXB), * BV(MXB), ITYPE(MXB), H(MXN) CHARACTER PROJECT*12, EXFILE*3 LOGICAL YES C======================================================================= DATA PROJECT / 'IMP4Q.DAT' / C======================================================================= C F(X) = X * X * ( 3.D0- 2.D0* X ) C G(X) = X * ( (0.1D0-1.D0)* X + (2.D0- 0.1D0) ) F(X) = X G(X) = X C======================================================================= WRITE (*,*)' INPUT DATA FILE = ', PROJECT C======================================================================= C BASIC PARAMTERS C------ EXX, EXY, EYY = TRANMISSIVITY EXX = 1.D0 EXY = 0.D0 EYY = 1.D0 C------ STORAGE = STRATIVITY STORAGE = 1.D0 DT = 0.1D0 MXNTIME = 100 THETA = 0.5D0 C ELEMENT CREATION NE = 0 DO J = 1 , NEX DO I = 1 , NEY NE = NE + 1 IF ( NE .GT. MXE ) STOP 'NE > MXE' NODEX(NE,1) = NDY*(J-1) + I NODEX(NE,2) = NODEX(NE,1) + NDY NODEX(NE,3) = NODEX(NE,2) + 1 NODEX(NE,4) = NODEX(NE,1) + 1 END DO END DO C======================================================================= C NODAL COORDINATE CREATION NNODE = 0 DO I = 1 , NDX DO J = 1 , NDY NNODE = NNODE + 1 IF ( NNODE .GT. MXN ) STOP 'NNODE > MXN' XCOORD(NNODE) = TLX * F( DX*(I-1)/TLX ) YCOORD(NNODE) = TLY * G( DY*(J-1)/TLY ) END DO END DO C======================================================================= C BOUNDARY CONDITIONS C--------- FACE OF -X NBF = 0 NDYPRT1 = NDY/3 CCCCCCC DO J = 2 , NDY-1 DO J = 1, NDYPRT1 NBF = NBF + 1 IBNDF(NBF) = J ITYPE(NBF) = 1 BV(NBF) = WAVEH END DO C DO J = NDYPRT1+1,NDY-1 C NBF = NBF + 1 C IBNDF(NBF) = J C ITYPE(NBF) = 1 C BV(NBF) = 0.D0 C END DO C--------- FACE OF -Y C DO I = 1 , NDX C NBF = NBF + 1 C IBNDF(NBF) = 1 + NDY*(I-1) C ITYPE(NBF) = 1 C BV(NBF) = 0.D0 C END DO C--------- FACE OF +Y DO I = 1 , NDX NBF = NBF + 1 IBNDF(NBF) = I*NDY ITYPE(NBF) = 1 BV(NBF) = 0.D0 END DO C--------- FACE OF +X DO I = 2 , NEY NBF = NBF + 1 IBNDF(NBF) = NEX*NDY + I ITYPE(NBF) = 1 BV(NBF) = 0.D0 END DO C======================================================================= C INITIAL CONDITION DO I = 1 , NNODE H(I) = 0.D0 END DO C======================================================================= C DATA FILE INQUIRY EXFILE = 'NEW' INQUIRE ( FILE = PROJECT, EXIST = YES ) IF ( YES ) EXFILE='OLD' C======================================================================= C MAKING DATA FILES OPEN ( 1, FILE=PROJECT, STATUS = EXFILE ) C------ CONTROL PARAMETERS WRITE (1,*) EXX, EXY, EYY WRITE (1,*) STORAGE WRITE (1,*) DT, MXNTIME WRITE (1,*) THETA C------ ELEMENTS WRITE(1,*) NE DO I = 1 , NE WRITE (1,*) I, (NODEX(I,J), J = 1 , ND ) END DO C------ NODAL COORDINATES WRITE(1,*) NNODE DO I = 1 , NNODE WRITE(1,*) I,XCOORD(I), YCOORD(I) END DO C------ BOUNDARY CONDITIONS WRITE(1,*) NBF DO I = 1 , NBF WRITE (1,*) IBNDF(I), ITYPE(I), BV(I) END DO CLOSE (1) C------ INITIAL CONDITION OPEN (1,FILE='SOLUTION.BIN',STATUS='UNKNOWN',FORM='UNFORMATTED') WRITE(1) ( H(I) , I=1,NNODE ) CLOSE (1) C======================================================================= CALL BANDWID ( ND, MXE, NE, NODEX , NBW ) C------ CREATION OF PARAMETER FILE TO BE USED IN INCLUDE STATEMENT OPEN ( 1, FILE='PARAM.DAT', STATUS='UNKNOWN' ) WRITE (1,*) ' PARAMETER ( ND=',ND,')' WRITE (1,*) ' PARAMETER ( INTEPT=',INTEPT,')' WRITE (1,*) ' PARAMETER ( MXE=',NE,')' WRITE (1,*) ' PARAMETER ( MXN=',NNODE,')' WRITE (1,*) ' PARAMETER ( MXW=',NBW,')' WRITE (1,*) ' PARAMETER ( MXB=',NBF,')' CLOSE (1) C======================================================================= STOP "NORMAL TERMINATION" END C C SUBROUTINE BANDWID ( ND, MXE, NE, NODEX , NBW ) IMPLICIT REAL*8 ( A-H , O-Z ) DIMENSION NODEX(MXE,ND) NBW = 0 DO I = 1 , NE DO J = 1 , ND-1 DO K = J+1 , ND NBW = MAX0(NBW,IABS(NODEX(I,J)-NODEX(I,K))) END DO END DO END DO NBW = NBW + 1 WRITE(*,*) 'HALF BANDWIDTH + 1 =', NBW RETURN END