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.
110 lines
3.4 KiB
Fortran
110 lines
3.4 KiB
Fortran
5 years ago
|
SUBROUTINE SAVEEQ
|
||
|
|
USE WINTERACTER
|
||
|
|
|
||
|
|
USE BLKELTLD
|
||
|
|
|
||
|
|
include 'D.inc'
|
||
|
|
character*255 fnamein,filter
|
||
|
|
CHARACTER *24 DATAOUT
|
||
|
|
|
||
|
|
filter='Element Input files|*.elt|'
|
||
|
|
CALL WSelectFile(filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAMEIN,'Element Load File Name')
|
||
|
|
IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
|
||
|
|
|
||
|
|
OPEN(202,FILE=FNAMEIN,STATUS='UNKNOWN')
|
||
|
|
ELSE
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
IF(IRMATYP .EQ. 11) WRITE(202,6000)
|
||
|
|
6000 FORMAT('TI')
|
||
|
|
IF(IRMATYP .EQ. 2 .OR. IRMATYP .EQ. 10) WRITE(202,6001)
|
||
|
|
6001 FORMAT('TE')
|
||
|
|
DO I=1,NQHYD
|
||
|
|
HRYEAR=365*24.
|
||
|
|
IYR=IYDATE(I)
|
||
|
|
IF(MOD(IYDATE(I),4) .EQ. 0) HRYEAR=HRYEAR+24.
|
||
|
|
IF(IRMATYP .EQ. 2 .OR. IRMATYP .EQ. 10) THEN
|
||
|
|
WRITE(202,6002) NCLINE(I),NEST(I),IYDATE(I),XYCEL(I,1),XYCEL(I,2)
|
||
|
|
!6002 FORMAT('QEI',5X,3I8)
|
||
|
|
6002 FORMAT('QEI',5X,3I8,2F16.2)
|
||
|
|
NST=NHYE(I)
|
||
|
|
DO N=1,NST
|
||
|
|
IF(TAE(N,I) .GE. HRYEAR) THEN
|
||
|
|
TAOUT=TAE(N,I)-HRYEAR
|
||
|
|
IYR=IYR+1
|
||
|
|
ELSE
|
||
|
|
IF(N .GT. 1) THEN
|
||
|
|
IF(TAE(N,I) .LT.TAE(N-1,I)) IYR=IYR+1
|
||
|
|
ENDIF
|
||
|
|
TAOUT=TAE(N,I)
|
||
|
|
ENDIF
|
||
|
|
CALL ENCODDAT(DATAOUT,TAE(N,I),IYR)
|
||
|
|
IF(IRMATYP .EQ. 2) THEN
|
||
|
|
WRITE(202,6003) DATAOUT,HAE(N,I)
|
||
|
|
6003 FORMAT(A24,F8.3)
|
||
|
|
ELSE
|
||
|
|
WRITE(202,6004) DATAOUT,ILAYRE(N,I),HAE(N,I),(HDE(N,I,K),K=1,3)
|
||
|
|
6004 FORMAT(A24,I8,F8.3,3F8.2)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
|
||
|
|
ELSEIF(IRMATYP .EQ. 11) THEN
|
||
|
|
WRITE(202,6002) NCLINE(I),NEST(I),IYDATE(I),XYCEL(I,1),XYCEL(I,2)
|
||
|
|
NST=NHYE(I)
|
||
|
|
DO N=1,NST
|
||
|
|
IF(TAE(N,I) .GE. HRYEAR) THEN
|
||
|
|
TAOUT=TAE(N,I)-HRYEAR
|
||
|
|
IYR=IYR+1
|
||
|
|
ELSE
|
||
|
|
IF(N .GT. 1 .AND. TAE(N,I) .LT.TAE(N-1,I)) IYR=IYR+1
|
||
|
|
TAOUT=TAE(N,I)
|
||
|
|
ENDIF
|
||
|
|
CALL ENCODDAT(DATAOUT,TAE(N,I),IYR)
|
||
|
|
WRITE(202,6006) DATAOUT,HAE(N,I),(HDE(N,I,K),K=1,3)
|
||
|
|
6006 FORMAT(A24,4F8.3)
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
WRITE(202,6010)
|
||
|
|
6010 FORMAT('ENDDATA')
|
||
|
|
CLOSE (202)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE ENCODDAT(DATAOUT,DAYJUL,IYR)
|
||
|
|
CHARACTER*24 DATAOUT
|
||
|
|
REAL DAYJUL,TIME
|
||
|
|
INTEGER IMTS(12,2),IDAY,IMO,IYR,RMIN
|
||
|
|
DATA IMTS/0,31,59,90,120,151,181,212,243,273,304,334,0,31,60,91,121,152,182,213,244,274,305,335/
|
||
|
|
LP=1
|
||
|
|
IF(MOD(IYR,4) .EQ. 0) LP=2
|
||
|
|
DO K=1,12
|
||
|
|
|
||
|
|
IF(DAYJUL/24. .LT. IMTS(K,LP)) THEN
|
||
|
|
IMO=K-1
|
||
|
|
IDAY=DAYJUL/24.-IMTS(IMO,LP)+1
|
||
|
|
IDT=DAYJUL/24.
|
||
|
|
HR=DAYJUL-FLOAT(IDT)*24.
|
||
|
|
IHR=HR
|
||
|
|
RMIN=(HR-FLOAT(IHR))*60.+.5
|
||
|
|
GO TO 100
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
IMO=12
|
||
|
|
IDAY=DAYJUL/24.-(334+LP-1)+1
|
||
|
|
IDT=DAYJUL/24.
|
||
|
|
HR=DAYJUL-FLOAT(IDT)*24.
|
||
|
|
IHR=HR
|
||
|
|
RMIN=(HR-FLOAT(IHR))*60.+.5
|
||
|
|
|
||
|
|
100 IF(IHR .LT. 10) THEN
|
||
|
|
WRITE(DATAOUT(1:24),6000) IDAY,IMO,IYR,IHR,RMIN
|
||
|
|
6000 FORMAT('QM',7X,I2.2,'/',I2.2,'/',I4,I2,':',I2.2)
|
||
|
|
ELSE
|
||
|
|
WRITE(DATAOUT(1:24),6001) IDAY,IMO,IYR,IHR,RMIN
|
||
|
|
6001 FORMAT('QM',6X,I2.2,'/',I2.2,'/',I4,I3,':',I2.2)
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
|