Esope source files

   1 : C CALPCO    SOURCE    GOUNAND   06/01/18    21:15:11     5293           
   2 :       SUBROUTINE CALPCO(POWCOF,TATRAV,
   3 :      $           IPROCO,IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : CALPCO
   8 : C DESCRIPTION : Calcul d'un produit de coefficients 
   9 : C               à une certaine puissance
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C APPELES          : 
  17 : C APPELES (E/S)    : 
  18 : C APPELES (BLAS)   :
  19 : C APPELES (CALCUL) :
  20 : C APPELE PAR       :
  21 : C***********************************************************************
  22 : C SYNTAXE GIBIANE    :
  23 : C ENTREES            :
  24 : C ENTREES/SORTIES    :
  25 : C SORTIES            :
  26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27 : C***********************************************************************
  28 : C VERSION    : v1, 19/12/2005, version initiale
  29 : C HISTORIQUE : v1, 19/12/2005, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 : -INC CCOPTIO
  38 : CBEGININCLUDE SMPOUET
  39 :       SEGMENT TABGEO
  40 :       CHARACTER*4 DISGEO
  41 :       POINTEUR IGEO.MCHAEL
  42 :       ENDSEGMENT
  43 :       SEGMENT TABVDC
  44 :       INTEGER VVARPR(NUMVPR)
  45 :       INTEGER VVARDU(NUMVDU)
  46 :       INTEGER VDATPR(NUMDPR)
  47 :       INTEGER VDATDU(NUMDDU)
  48 :       INTEGER VCOFPR(NUMCPR)
  49 :       INTEGER VCOFDU(NUMCDU)
  50 :       INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  51 :       INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  52 :       POINTEUR VLCOF(JLCOF).MLENTI
  53 :       POINTEUR VCOMP(JGCOF).COMP
  54 :       POINTEUR VLDAT(JGCOF).MLENTI
  55 :       INTEGER  DJSVD(JGVD)
  56 :       POINTEUR NOMVD(JGVD).MLMOTS
  57 :       POINTEUR MVD(JGVD).MCHPOI
  58 :       REAL*8 XVD(JGVD)
  59 :       CHARACTER*4 DISVD(KGVD)
  60 :       ENDSEGMENT
  61 :       SEGMENT TATRAV
  62 :       POINTEUR VVCOF(JLCOF).MCHEVA
  63 :       POINTEUR VCOF(JGCOF).MCHEVA
  64 :       POINTEUR IVD(JGVD).MCHAEL
  65 :       POINTEUR VD(JGVD).MCHEVA
  66 :       POINTEUR DVD(JGVD).MCHEVA
  67 :       POINTEUR FFVD(KGVD).MCHEVA
  68 :       POINTEUR DFFVD(KGVD).MCHEVA
  69 :       LOGICAL LVCOF(JGCOF)
  70 :       LOGICAL LVD(JGVD)
  71 :       LOGICAL LDVD(JGVD)
  72 :       LOGICAL LFFVD(KGVD)
  73 :       LOGICAL LDFFVD(KGVD)
  74 :       ENDSEGMENT
  75 :       SEGMENT TABMAT
  76 :       POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  77 :       ENDSEGMENT
  78 : CENDINCLUDE SMPOUET
  79 : -INC SMLENTI
  80 :       POINTEUR POWCOF.MLENTI
  81 : CBEGININCLUDE SMCHAEL
  82 :       SEGMENT MCHAEL
  83 :       POINTEUR IMACHE(N1).MELEME
  84 :       POINTEUR ICHEVA(N1).MCHEVA
  85 :       ENDSEGMENT
  86 :       SEGMENT MCHEVA
  87 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  88 :       ENDSEGMENT
  89 :       SEGMENT LCHEVA
  90 :       POINTEUR LISCHE(NBCHE).MCHEVA
  91 :       ENDSEGMENT
  92 : CENDINCLUDE SMCHAEL
  93 :       POINTEUR LCOF.LCHEVA
  94 :       POINTEUR MYCOF.MCHEVA
  95 : * Segments où l'on stocke les nombres d'éléments et nombre de points de
  96 : * Gauss pour chaque champ à fin de vérification
  97 :       POINTEUR LNELEM.MLENTI
  98 :       POINTEUR LNPOGA.MLENTI
  99 :       POINTEUR LPOW.MLENTI
 100 :       POINTEUR IPROCO.MCHEVA
 101 : *
 102 :       INTEGER IMPR,IRET
 103 : *     
 104 : * Executable statements
 105 : *
 106 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans calpco.eso' 
 107 : *
 108 :       NBCHE=0
 109 :       SEGINI LCOF
 110 :       JG=0 
 111 :       SEGINI LNELEM
 112 :       JG=0 
 113 :       SEGINI LNPOGA
 114 :       JG=0 
 115 :       SEGINI LPOW
 116 :       SEGACT POWCOF
 117 :       JGCOF=POWCOF.LECT(/1)
 118 :       DO IJGCOF=1,JGCOF
 119 :          IPOW=POWCOF.LECT(IJGCOF)
 120 :          IF (IPOW.NE.0) THEN
 121 :             MYCOF=TATRAV.VCOF(IJGCOF)
 122 :             SEGACT MYCOF
 123 :             NDLIG =MYCOF.VELCHE(/1)
 124 :             NDCOL =MYCOF.VELCHE(/2)
 125 :             N2DLIG=MYCOF.VELCHE(/3)
 126 :             N2DCOL=MYCOF.VELCHE(/4)
 127 :             NEL=MYCOF.VELCHE(/6)
 128 :             NPG=MYCOF.VELCHE(/5)
 129 :             SEGDES MYCOF
 130 :             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
 131 :      $           N2DCOL.NE.1) THEN
 132 :                WRITE(IOIMP,*) 'Erreur dims MYCOF'
 133 :                WRITE(IOIMP,*) 'IJGCOF=',IJGCOF
 134 :                WRITE(IOIMP,*) 'NDLIG=',NDLIG
 135 :                WRITE(IOIMP,*) 'NDCOL=',NDCOL
 136 :                WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
 137 :                WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
 138 :                WRITE(IOIMP,*) 'NPG   =',NPG
 139 :                WRITE(IOIMP,*) 'NEL   =',NEL
 140 :                GOTO 9999
 141 :             ENDIF
 142 :             LCOF.LISCHE(**)=MYCOF
 143 :             LNELEM.LECT(**)=NEL
 144 :             LNPOGA.LECT(**)=NPG
 145 :             LPOW.LECT(**)=IPOW
 146 :          ENDIF
 147 :       ENDDO
 148 :       SEGDES POWCOF
 149 : * Vérifications des dimensions
 150 : *   Calcul des max
 151 :       JG=LNELEM.LECT(/1)
 152 :       NELMAX=1
 153 :       NPGMAX=1
 154 :       DO IG=1,JG
 155 :          NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
 156 :          NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
 157 :       ENDDO
 158 : *   Vérif proprement dite
 159 :       DO IG=1,JG
 160 :          NEL=LNELEM.LECT(IG)
 161 :          NPG=LNPOGA.LECT(IG)
 162 :          IF ((NPG.NE.1.AND.NPG.NE.NPGMAX)
 163 :      $     .OR.(NEL.NE.1.AND.NEL.NE.NELMAX)) THEN
 164 :             WRITE(IOIMP,*) 'Erreur dims MYCOF'
 165 :             WRITE(IOIMP,*) 'MYCOF=',LCOF.LISCHE(IG)
 166 :             WRITE(IOIMP,*) 'NPG=',NPG
 167 :             WRITE(IOIMP,*) 'NEL=',NEL
 168 :             WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
 169 :             WRITE(IOIMP,*) 'NELMAX=',NELMAX
 170 :             GOTO 9999
 171 :          ENDIF
 172 :       ENDDO
 173 : *
 174 : * Initialisation du segment contenant la valeur de la loi de
 175 : * comportement
 176 :       NBLIG=1
 177 :       NBCOL=1
 178 :       N2LIG=1
 179 :       N2COL=1
 180 :       NBPOI=NPGMAX
 181 :       NBELM=NELMAX
 182 :       SEGINI IPROCO
 183 :       DO IBELM=1,NBELM
 184 :          DO IBPOI=1,NBPOI
 185 :             IPROCO.VELCHE(1,1,1,1,IBPOI,IBELM)=1.D0
 186 :          ENDDO
 187 :       ENDDO
 188 : *
 189 : * Calcul proprement dit 
 190 : *
 191 :       DO IG=1,JG
 192 :          MYCOF=LCOF.LISCHE(IG)
 193 :          NEL=LNELEM.LECT(IG)
 194 :          NPG=LNPOGA.LECT(IG)
 195 :          IPOW=LPOW.LECT(IG)
 196 :          SEGACT MYCOF
 196 :          CALL CALPC1(IPROCO.VELCHE,NPGMAX,NELMAX,
 197 :      $        MYCOF.VELCHE,NPG,NEL,IPOW,
 198 :      $        IMPR,IRET)
 199 :          IF (IRET.NE.0) GOTO 9999
 200 :          SEGDES MYCOF
 201 :       ENDDO
 202 :       SEGSUP LCOF
 203 :       SEGSUP LNELEM
 204 :       SEGSUP LNPOGA
 205 :       SEGSUP LPOW
 206 : *
 207 : * Fin
 208 : *
 209 :       SEGDES IPROCO
 210 : 
 211 : 
 212 : *
 213 : * Normal termination
 214 : *
 215 :       IRET=0
 216 :       RETURN
 217 : *
 218 : * Format handling
 219 : *
 220 : *
 221 : * Error handling
 222 : *
 223 :  9999 CONTINUE
 224 :       IRET=1
 225 :       WRITE(IOIMP,*) 'An error was detected in subroutine calpco'
 226 :       RETURN
 227 : *
 228 : * End of subroutine CALPCO
 229 : *
 230 :       END
 231 : 
 232 :  
 233 :