Télécharger la plaquette Cast3M


fr en

Télécharger wratta.eso

Retour à la liste

Numérotation des lignes : 

wratta

  1. C WRATTA    SOURCE    CHAT      05/01/13    04:11:59     5004
  2.       SUBROUTINE WRATTA(IOSAU,ITLACC,IMAX1,IRET,IFORM,IDEB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C      BUT     : ECRITURE DES ATTAC SUR LE FICHIER IOSAU
  7. C      APPELE PAR WRPIL
  8. C      APPELLE : ECDIFE ECDIFM ECDIFR
  9. C              : ECDES ECDIFP  JDANSI
  10. C      ECRIT PAR FARVACQUE   - REPRIS PAR LENA
  11. C=======================================================================
  12. -INC SMATTAC
  13.       SEGMENT/ITLACC/(ITLAC(0)),ITLAC1.ITLACC,ITLAC2.ITLACC,
  14.      1 ITLAC3.ITLACC,ITLAC4.ITLACC,ITLAC5.ITLACC,ITLAC6.ITLACC
  15.       DIMENSION ILENA(10)
  16. C     ***************************** MATTAC *****************************
  17.       IRET=0
  18.  6015 CONTINUE
  19.       DO 150 IEL=IDEB,IMAX1
  20.          MATTAC=ITLAC(IEL)
  21.          SEGACT MATTAC
  22.          NN=LISATT(/1)
  23.          ILENA(1)=NN
  24.          CALL ECDIFE (IOSAU,1    , ILENA,IFORM)
  25.  
  26.          DO 151 I=1,NN
  27.             MSOUMA=LISATT(I)
  28.             SEGACT MSOUMA
  29.             M=IPMATK(/1)
  30.             N=IATREL(/1)
  31.             ILENA(1)= M
  32.             ILENA(2)= N
  33.             CALL ECDIFE (IOSAU,2    ,ILENA ,IFORM)
  34.             READ (ITYATT,FMT='(A4)') ILENA(1)
  35.             CALL ECDIFM (IOSAU,1    ,ILENA ,IFORM)
  36.             CALL ECDIFE (IOSAU,M    ,IPMATK,IFORM)
  37.             CALL ECDIFE (IOSAU,N    ,IATREL,IFORM)
  38.             CALL ECDIFE (IOSAU,1    ,IGEOCH,IFORM)
  39.             CALL ECDIFE (IOSAU,1    ,IPHYCH,IFORM)
  40.             IF(IGEOCH.EQ.0) GO TO 153
  41.             MGEOCH=IGEOCH
  42.             SEGACT MGEOCH
  43.             NI=INORCH(/1)
  44.             NJ=RJEUCH(/1)
  45.             N1=IMAPRO(/1)
  46.             NP= MPOPRO(/2)
  47.             NT=TAIPRO(/1)
  48.             ILENA(1)= NI
  49.             ILENA(2)= NJ
  50.             ILENA(3)= N1
  51.             ILENA(4)= NP
  52.             ILENA(5)= NT
  53.             CALL ECDIFE (IOSAU,5    ,ILENA,IFORM)
  54.             CALL ECDIFE (IOSAU,NI   ,INORCH,IFORM)
  55.             CALL ECDIFR (IOSAU,NJ   ,RJEUCH,IFORM)
  56.             CALL ECDIFE (IOSAU,N1   ,IMAPRO,IFORM)
  57.             READ (MPOPRO,FMT='(10A4)') (ILENA(II),II=1,NP)
  58.             CALL ECDIFM (IOSAU,NP   ,ILENA ,IFORM)
  59.             CALL ECDIFR (IOSAU,NT   ,TAIPRO,IFORM)
  60.             SEGDES MGEOCH
  61.   153       CONTINUE
  62.             IF(IPHYCH.EQ.0) GO TO 152
  63.             MPHYCH=IPHYCH
  64.             SEGACT MPHYCH
  65.             NRAI=1
  66.             NA=AMOPRO(/1)
  67.             NF= FROPRO(/1)
  68.             ILENA(1)= NRAI
  69.             ILENA(2)= NA
  70.             ILENA(3)= NF
  71.             CALL ECDIFE (IOSAU,3    ,ILENA,IFORM)
  72.             CALL ECDIFR (IOSAU,NRAI ,RAIPRO,IFORM)
  73.             CALL ECDIFR (IOSAU,NA   ,AMOPRO,IFORM)
  74.             CALL ECDIFR (IOSAU,NF   ,FROPRO,IFORM)
  75.             SEGDES MPHYCH
  76.   152       CONTINUE
  77.             SEGDES MSOUMA
  78.   151    CONTINUE
  79.          SEGDES MATTAC
  80.   150 CONTINUE
  81.       GOTO 1098
  82. C     ******************************************************************
  83.  1098 CONTINUE
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales