Télécharger la plaquette Cast3M


fr en

Télécharger smdpro.eso

Retour à la liste

Numérotation des lignes : 

smdpro

  1. C SMDPRO    SOURCE    CB215821  20/07/31    21:15:17     10678          
  2. C***********************************************************************
  3. C NOM         : smdpro.eso
  4. C DESCRIPTION : Ecriture des profils et des champs
  5. C***********************************************************************
  6. C HISTORIQUE :  29/11/2017 : RPAREDES : CREATION
  7. C HISTORIQUE :
  8. C***********************************************************************
  9. C Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  10. C en cas de modification de ce sous-programme afin de faciliter
  11. C la maintenance !
  12. C***********************************************************************
  13. C APPELÉ PAR : opérateur (SORT 'MED') sormed.eso
  14. C***********************************************************************
  15. C ENTRÉES :
  16. C             FID     : Id du fichier
  17. C             NOBJ    : Nom du maillage
  18. C             NBPR    : Nombre de profils
  19. C             INFSUP  : Segment avec l'info sur les profils
  20. C             NBCH    : Nombre de champs
  21. C             INFSCH  : Segment avec l'info sur les champs
  22. C SORTIES : aucune
  23. C***********************************************************************
  24.       SUBROUTINE smdpro(FID, NOBJ, NBPR, INFSUP, NBCH, INFSCH)
  25.       IMPLICIT INTEGER(i-n)
  26.       IMPLICIT REAL*8(a-h,o-z)
  27.  
  28. -INC CCMED
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC CCGEOME
  35. -INC SMCHAML
  36.  
  37. C ***** Déclaration des paramètres
  38.       INTEGER*4   FID
  39.       CHARACTER*8 NOBJ
  40.  
  41. C ***** Déclaration des variables
  42. C-----Définition des entiers
  43.       INTEGER*4 cret
  44.       INTEGER*4 ftype
  45.       INTEGER*4 psize
  46.       INTEGER*4 ncomp
  47.  
  48. C-----Chaines de Caractere de longueur MED_SNAME_SIZE=16
  49.       CHARACTER*16 dtunit
  50.  
  51.       CHARACTER*16 VID16
  52.       PARAMETER(VID16='                ')
  53.  
  54. C-----Chaines de Caractere de longueur MED_NAME_SIZE=64
  55.       CHARACTER*64 fname
  56.       CHARACTER*64 pname
  57.       CHARACTER*64 mname
  58.       CHARACTER*64 VID64
  59.       PARAMETER(VID64='
  60.      &               ')
  61.  
  62. C ***** Déclaration des segments      
  63.       SEGMENT SINT4
  64.         INTEGER INT4(psize)
  65.       ENDSEGMENT
  66.  
  67. C----- SEG INFSCH
  68. C         nbchps : nombre de champs
  69. C         NOMCHA : nom du champ
  70. C         IETYPE : type d'entité (etype)
  71. C         LISCOM : liste de SEG SLISCO (nom des composantes)   
  72.       SEGMENT INFSCH
  73.         CHARACTER*64 NOMCHA(nbchps)
  74.         INTEGER     IETYPE(nbchps)
  75.         INTEGER     LISCOM(nbchps)
  76.       ENDSEGMENT
  77.  
  78.       SEGMENT SLISCO
  79.         CHARACTER*16 LISSCP(nbcomp),LCUNIT(nbcomp)
  80.       ENDSEGMENT
  81.  
  82. C----- SEG INFSUP
  83. C         nbprof : nombre de profils
  84. C         NOMSUP : nom du support  
  85. C         LISSUP : liste de MELEME
  86. C         IGTYPE : type géométrique (gtype)  
  87. C         LISSME : liste de SEG SLISSU (numérotation)
  88.       SEGMENT INFSUP
  89.         CHARACTER*8 NOMSUP(nbprof)
  90.         INTEGER     IGTYPE(nbchps)
  91.         INTEGER     LISSUP(nbprof), LISSME(nbprof)
  92.       ENDSEGMENT
  93.  
  94.       SEGMENT SLISSU
  95.         INTEGER     LISSEL(nbelem), SNBNOD
  96.       ENDSEGMENT
  97.  
  98.  
  99. C **********************************************************************
  100. C     Creation des profils
  101. C **********************************************************************
  102.       DO ia = 1,NBPR       
  103.         SLISSU = INFSUP.LISSME(ia)
  104.         nbelem = SLISSU.LISSEL(/1)
  105.         pname  = INFSUP.NOMSUP(ia)
  106.         psize  = nbelem
  107.         SEGINI SINT4
  108.         CALL pfprw4(FID, pname, psize, SLISSU.LISSEL, SINT4.INT4, 
  109.      &              cret)
  110.         IF (cret .NE. 0) THEN
  111.           moterr(1:6) = 'pfprw4'
  112.           interr(1)   = cret
  113.           CALL ERREUR(873)
  114.           RETURN
  115.         ENDIF
  116.         SEGSUP SINT4
  117.       ENDDO
  118.  
  119. C **********************************************************************
  120. C     Creation des champs
  121. C **********************************************************************
  122.       DO ia = 1,NBCH
  123.         fname  = INFSCH.NOMCHA(ia)
  124.         ftype  = MED_FLOAT64
  125.         SLISCO = INFSCH.LISCOM(ia)
  126.         ncomp  = SLISCO.LISSCP(/2)
  127.         dtunit = VID16
  128.         mname  = NOBJ 
  129.         CALL mfdcre(FID, fname, ftype, ncomp, SLISCO.LISSCP, 
  130.      &              SLISCO.LCUNIT, dtunit, mname, cret)
  131.         IF (cret .NE. 0) THEN
  132.           moterr(1:6) = 'mfdcre'
  133.           interr(1)   = cret
  134.           CALL ERREUR(873)
  135.           RETURN
  136.         ENDIF
  137.       ENDDO
  138.  
  139.       RETURN
  140.       END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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