1 : C LFCDI2 SOURCE CHAT 08/09/18 21:15:04 6162 2 : SUBROUTINE LFCDI2(NBAND,LMAX,R,IRETOU,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : -INC CCOPTIO 6 : -INC CCFXDR 7 : DIMENSION R(1) 8 : external long 9 : ipas=0 10 : 10 IRETOU=0 11 : ios=1 12 : IF (LMAX.EQ.0) GO TO 1 13 : IF(IONIVE.GT.2) THEN 14 : IF (IFORM.EQ.1) READ(NBAND,8003,END=1001,ERR=1000) 15 : # (R(I),I=1,LMAX) 16 : IF (IFORM.EQ.0) READ(NBAND,END=1001,ERR=1000) (R(I),I=1,LMAX) 17 : ELSE 18 : IF (IFORM.EQ.1) READ(NBAND,8002,END=1001,ERR=1000) 19 : # (R(I),I=1,LMAX) 20 : IF (IFORM.EQ.0) READ(NBAND,END=1001,ERR=1000) (R(I),I=1,LMAX) 21 : ENDIF 22 : if (iform.eq.2) ios=IXDRDMAT( ixdrr, lmax,r(1)) 23 : * write (6,*) ' ios dans lfcdi2 ',ios 24 : if (ios.lt.0) goto 1001 25 : GO TO 1 26 : 1000 IRETOU=1 27 : 1 RETURN 28 : 1001 ll=long (nomres) 29 : ificle=ificle+1 30 : * write(6,*)' ificle ' , ificle 31 : if(ificle.eq.10000)then 31 : call erreur (945) 32 : iretou=1 33 : return 34 : endif 35 : if(ificle.eq.1) then 36 : nomres(ll+1:ll+2)='_1' 37 : ll=ll+2 38 : elseif ( ificle.lt.10) then 39 : write(nomres(ll:ll),fmt='(I1)')ificle 40 : elseif ( ificle.lt.100) then 41 : if(ificle.eq.10)ll = ll + 1 42 : write(nomres(ll-1:ll),fmt='(I2)')ificle 43 : elseif ( ificle.lt.1000) then 44 : if(ificle.eq.100)ll = ll + 1 45 : write(nomres(ll-2:ll),fmt='(I3)')ificle 46 : elseif ( ificle.lt.10000) then 47 : if(ificle.eq.1000)ll = ll + 1 48 : write(nomres(ll-3:ll),fmt='(I4)')ificle 49 : endif 50 : if (iform.ne.2) close (unit=nband) 51 : if (iform.eq.2) ios=IXDRCLOSE( ixdrr ) 52 : * write(6,*) ' fermeture et ouverture de ',nomres(1:ll) 53 : if(iform.eq.1) then 54 : OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll), 55 : # IOSTAT=IOS,ERR=2000,FORM='FORMATTED') 56 : ELSEif (iform.eq.0) then 57 : OPEN (UNIT=NBAND,STATUS='UNKNOWN',FILE=NOMRES(1:ll), 58 : # IOSTAT=IOS,ERR=2000,FORM='UNFORMATTED') 59 : else 60 : ios=INITXDR( NOMRES(1:ll),'r',.true.) 61 : if (ios.lt.0) goto 2000 62 : ENDIF 63 : write (6,*) 'Ouverture du fichier : ',nomres(1:ll) 64 : go to 10 65 : C -------------------- 66 : 8002 FORMAT(1P,6E13.6) 67 : 8003 FORMAT(1P,3E22.14) 68 : 2000 MOTERR=NOMRES(1:ll) 69 : INTERR(1)=IOS 69 : CALL ERREUR(424) 70 : RETURN 71 : END 72 : 73 : 74 : 75 : 76 : 77 : 78 : 79 : 80 : 81 : 82 : 83 : 84 : 85 : 86 : 87 : 88 :
© Cast3M 2003 - All rights reserved.
Disclaimer