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.
109 lines
2.3 KiB
Fortran
109 lines
2.3 KiB
Fortran
5 years ago
|
SUBROUTINE GETGRP
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
|
||
|
|
CHARACTER*8 IDSAV,ID
|
||
|
|
CHARACTER*72 DLINSAV,DLIN
|
||
|
|
|
||
|
|
IDSAV=ID
|
||
|
|
DLINSAV=DLIN
|
||
|
|
|
||
|
|
! ALLOCATE ARRAY SIZES
|
||
|
|
|
||
|
|
IF(.NOT. ALLOCATED(IGRPNUM)) THEN
|
||
|
|
ALLOCATE (IGRPNUM(25,MAXE),MAXENT(25))
|
||
|
|
IGRPNUM=0
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! NOW READ DATA TO FILE
|
||
|
|
|
||
|
|
CALL GINPT(IGRP,ID,DLIN)
|
||
|
|
IF(ID(1:3) .EQ. 'TIT') THEN
|
||
|
|
|
||
|
|
! READ TITLE
|
||
|
|
|
||
|
|
READ(DLIN,'(A72)') HEDR
|
||
|
|
CALL GINPT(IGRP,ID,DLIN)
|
||
|
|
ENDIF
|
||
|
|
MAXIGRP=0
|
||
|
|
|
||
|
|
301 READ(DLIN,'(I8)') IGRPA
|
||
|
|
CALL GINPT(IGRP,ID,DLIN)
|
||
|
|
NL=1
|
||
|
|
NH=9
|
||
|
|
|
||
|
|
401 CONTINUE
|
||
|
|
IF(ID(1:3) .EQ. 'NGP') THEN
|
||
|
|
READ(DLIN,'(9I8)') (IGRPNUM(IGRPA,I),I=NL,NH)
|
||
|
|
CALL GINPT(IGRP,ID,DLIN)
|
||
|
|
IF(IGRPNUM(IGRPA,NH) .NE. 0) THEN
|
||
|
|
NL=NL+9
|
||
|
|
NH=NH+9
|
||
|
|
GO TO 401
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
! SET MAXIMA FROM INPUT FILE
|
||
|
|
|
||
|
|
IF(MAXIGRP .LT. IGRPA) MAXIGRP=IGRPA
|
||
|
|
MAXENT(IGRPA)=NH
|
||
|
|
|
||
|
|
IF(ID(1:3) .EQ. 'GRP') GO TO 301
|
||
|
|
CALL TOSER
|
||
|
|
ID=IDSAV
|
||
|
|
DLIN=DLINSAV
|
||
|
|
CALL PLOTOT(1)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE WRTGP
|
||
|
|
|
||
|
|
USE WINTERACTER
|
||
|
|
USE BLK1MOD
|
||
|
|
include 'd.inc'
|
||
|
|
|
||
|
|
CHARACTER(LEN=256) :: FILTER
|
||
|
|
CHARACTER(LEN=96) :: FNAME
|
||
|
|
LOGICAL :: OPENED
|
||
|
|
|
||
|
|
IGRPOUT=29
|
||
|
|
INQUIRE(29, OPENED=OPENED)
|
||
|
|
if(.not. opened) then
|
||
|
|
Filter='TXT file -- *.txt|*.txt|'
|
||
|
|
|
||
|
|
CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Group File')
|
||
|
|
|
||
|
|
IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
|
||
|
|
|
||
|
|
OPEN(IGRPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
|
||
|
|
ELSE
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
CALL TOPAR
|
||
|
|
REWIND IGRPOUT
|
||
|
|
WRITE(IGRPOUT,'(a)') 'TIT GROUP FILE'
|
||
|
|
|
||
|
|
DO K=1,25
|
||
|
|
IF(MAXENT(K) .GT. 0) THEN
|
||
|
|
WRITE(IGRPOUT,6001) K
|
||
|
|
LROWS=MAXENT(K)/9+1
|
||
|
|
LASTCOL=MOD(MAXENT(K),9)
|
||
|
|
IF(LASTCOL .EQ. 0) THEN
|
||
|
|
IF(IGRPNUM(K,MAXENT(K)) .EQ. 0) THEN
|
||
|
|
LROWS=LROWS-1
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
NL=-8
|
||
|
|
DO LL=1,LROWS
|
||
|
|
NL=NL+9
|
||
|
|
NH=NL+8
|
||
|
|
WRITE(IGRPOUT,6002) (IGRPNUM(K,L),L=NL,NH)
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
6001 FORMAT('NGP ',I8)
|
||
|
|
6002 FORMAT('GRP ',9I8)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|