Esope source files

   1 : C RECOF1    SOURCE    KICH      06/03/17    21:17:14     5342           
   2 :       SUBROUTINE RECOF1(itbst,itbm,ichp1,ipout)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : 
   6 :       CHARACTER*4  mocom1,motddl
   7 : -INC CCOPTIO                                                                    
   8 : -INC SMCHPOI
   9 : -INC SMELEME
  10 : -INC SMTABLE
  11 : -INC SMCOORD
  12 : 
  13 :       segment icta
  14 :         integer icpt(ima)
  15 :         character*4 iccomp(ima)
  16 :       endsegment
  17 :       segment icpr(nbpts)
  18 :       
  19 : 
  20 :       nbpts=xcoor(/1)/(idim+1)
  21 :       segini icpr
  22 :           mtable = itbst
  23 :           segact mtable
  24 :           ima = mlotab - 1
  25 :       segini icta
  26 :       ipout = 0 
  27 :       if (itbm.gt.0) then 
  27 :           CALL ACCTAB(itbm,'MOT',0,0.0D0,'MODES',.TRUE.,0,
  28 :      &        'TABLE',0,0.0D0,' ',.TRUE.,ITBM2)   
  29 :          if (ierr.ne.0) return
  30 :       endif       
  31 :       mchpoi = ichp1 
  32 :       segact mchpoi
  33 :       nsoupo = ipchp(/1)
  34 :       DO is = 1 ,nsoupo
  35 :        msoupo = ipchp(is)
  36 :        segact msoupo
  37 :        NC = NOCOMP(/2)
  38 :        meleme = igeoc
  39 :        mpoval = ipoval
  40 :        segact meleme,mpoval
  41 :        N = vpocha(/1)
  42 :        DO ic = 1,NC
  43 :         mocom1 = nocomp(ic)
  44 :         if (mocom1.eq.'BETA') then
  45 :           mtable = itbst
  46 :           segact mtable
  47 :           ima = mlotab - 1
  48 :         else if (mocom1.eq.'ALFA'.and.itbm2.gt.0) then
  49 :           mtable = itbm2
  50 :           segact mtable
  51 :           ima = mlotab - 2
  52 :         else
  53 :           goto 95
  54 :         endif
  55 :         DO 90 ipn = 1 , N
  56 :           ipts = num(1,ipn)
  57 :           sca1 = vpocha(ipn,ic)
  58 :            do 85 im =1,ima
  58 :           CALL ACCTAB(mtable,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
  59 :      &        'TABLE',0,0.0D0,' ',.TRUE.,ITMOD)
  60 :              if (ierr.ne.0) return
  60 :           CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'POINT_REPERE',.TRUE.,0,
  61 :      &        'POINT',0,0.0D0,' ',.TRUE.,IPOI)
  62 :              if (ierr.ne.0) return
  63 :              if (ipoi.ne.ipts) goto 85
  64 :              if (mocom1.eq.'BETA') then
  64 :           CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'DEFORMEE',.TRUE.,0,
  65 :      &        'CHPOINT',0,0.0D0,' ',.TRUE.,ICHIN)                            
  65 :           CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
  66 :      &        'POINT',0,0.0D0,' ',.TRUE.,IPL1)
  66 :           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.TRUE.,I6,
  67 :      &        'MOT',I7,X1,motddl,.TRUE.,I7)
  68 :                icpt(im) = ipl1
  69 :                iccomp(im) = motddl
  70 :                icpr(ipl1) = icpr(ipl1) + 1
  71 :              else if (mocom1.eq.'ALFA') then
  71 :           CALL ACCTAB(ITMOD,'MOT',0,0.0D0,'DEFORMEE_MODALE',.TRUE.,0,
  72 :      &        'CHPOINT',0,0.0D0,' ',.TRUE.,ICHIN)
  73 :              else
  74 :              endif
  75 :              if (ipout.gt.0) then
  76 :               ich1 = ipout
  76 :               call adchpo(ich1,ichin,ipout,1.d0,sca1)
  77 :              else     
  77 :               call muchpo(ichin,sca1,ipout,1)
  78 :              endif     
  79 :              goto 90
  80 :  85        continue
  81 :  90     CONTINUE
  82 :  95     continue
  83 :        ENDDO
  84 : 
  85 :        segdes msoupo,meleme,mpoval
  86 :       ENDDO
  87 :       segdes mchpoi
  88 : * correction du chpoint aux points de liaison
  89 : 
  90 :       ima = icpt(/1)
  91 :       mchpoi = ipout 
  92 :       segact mchpoi
  93 :       nsoupo = ipchp(/1)
  94 :       DO is = 1 ,nsoupo
  95 :        msoupo = ipchp(is)
  96 :        segact msoupo
  97 :        NC = NOCOMP(/2)
  98 :        meleme = igeoc
  99 :        mpoval = ipoval
 100 :        segact meleme,mpoval*mod
 101 :        N = vpocha(/1)
 102 :        DO ic = 1,NC
 103 :         mocom1 = nocomp(ic)
 104 : 
 105 :         DO 180 ipn = 1 , N
 106 :           ipts = num(1,ipn)
 107 :           kpt = 0
 108 :             if (icpr(ipts).eq.0) goto 180
 109 :             do 170 im = 1,ima
 110 :               if (icpt(im).ne.ipts) goto 170
 111 :               if (iccomp(im).ne.mocom1) goto 170
 112 :               kpt = kpt + 1
 113 :  170        continue
 114 : 
 115 :           if (kpt.ne.0) vpocha(ipn,ic) = vpocha(ipn,ic)/kpt
 116 : 
 117 :  180   CONTINUE
 118 : 
 119 :        ENDDO
 120 :       ENDDO
 121 : 
 122 :       segdes mchpoi
 123 :       segsup icta,icpr
 124 : 
 125 :       RETURN
 126 :       END
 127 :  
 128 :