C C SUBROUTINE CRTSTY C C FUNCTION C TO CREATE A DYNAMIC STUDY C C MODIFIED VERSION OF CSTUDY C C CALL CRTSTY(STUDY,ICHAN,IBLKS,NEWSTY,NDEV) C C C WHERE C C STUDY ORIGINAL STUDY RAD50 NAME C ICHAN I/O CHANNEL FOR NEW STUDY C IBLKS NO.BLOCKS FOR NEW STUDY C NEWSTY NEW STUDY RAD50 NAME C NDEV DEVICE FOR NEW STUDY C C SUBROUTINE CRTSTY(STUDY,ICHAN,IBLKS,NEWSTY,NDEV) LOGICAL*1 SNAME(12) INTEGER*2 STUDY(4),NEWSTY(4),EXTX00,EXTX99 DATA EXTX00/3RX00/,EXTX99/3RX99/ C C TEST GAMMA MAGTAPE FORMAT C IF (STUDY(4).LT.EXTX00.OR.STUDY(4).GT.EXTX99) 1STUDY(4) = EXTX00 C C CREATE NEW STUDY FILES C CALL R50ASC(12,STUDY,SNAME) D WRITE(7,100)(SNAME(I),I=1,12) D100 FORMAT(' FROM CRTSTY ',12A1,//) C C IF SY NO.>= 3 CREATE NEW STUDY ON SY1 C IF(SNAME(3).GE.'3')SNAME(3)='1' C C CHECK FOR SAME NAME ?? C GOTO 3 4 IF (SNAME(12).NE.'9') GOTO 5 SNAME(12) = "57 IF (SNAME(11).EQ.'9') SNAME(11) = "57 IF (SNAME(11).NE.'9') SNAME(11) = SNAME(11) + 1 5 SNAME(12) = SNAME(12) + 1 3 CALL IRAD50(12,SNAME,NEWSTY) NUMBKS = -2 !IGNORE -2 ERROR IN CRTFIL CALL CRTFIL(NEWSTY,NUMBKS,ICHAN,1) CALL CLOSEC(ICHAN) CALL IFREEC(ICHAN) IF (NUMBKS.EQ.-2) GOTO 6 C C FILE EXISTS GET NEW EXTENSION NUMBER C GOTO 4 C C CREATE NEW FILE C 6 IF(IBLKS.EQ.0)IBLKS=1000 CALL CRTFIL(NEWSTY,IBLKS,ICHAN,0) RETURN END