Download mocur.eso

Back to the list

   1 : C MOCUR     SOURCE    CHAT      11/03/16    21:28:04     6902           
   2 :       SUBROUTINE MOCUR
   3 : **********************************************************************
   4 : *
   5 : *     OPERATEUR MOCU  (MOment/CUrvature)
   6 : *
   7 : **********************************************************************
   8 : *     Pierre Pegon (ISPRA) Juillet/Aout 1993
   9 : **********************************************************************
  10 :       IMPLICIT INTEGER(I-N)
  11 :       IMPLICIT REAL*8(A-H,O-Z)
  12 : C
  13 :       DIMENSION DEPSI(6),SIGMA(6),CRIGI(12),CMASS(12)
  14 :       logical zveri
  15 : C
  16 : -INC CCOPTIO
  17 : -INC SMLREEL
  18 : -INC CCGEOME
  19 : -INC CCREEL
  20 : -INC SMMODEL
  21 : -INC SMCHAML
  22 :       POINTEUR IPCURY.MLREEL,IPCURZ.MLREEL,IPAXIA.MLREEL
  23 :       POINTEUR IPMOMY.MLREEL,IPMOMZ.MLREEL,IPEPAX.MLREEL
  24 : C
  25 :       NMAXIT=50
  26 :       NSTRS2 = 6
  27 :       zveri=.false.
  28 : C
  29 :       ICOUL1=IDCOUL
  30 : C
  31 : C
  32 : C------- READ THE INPUT --
  33 :       IF ((IFOUR.EQ.-2).OR.(IFOUR.EQ.-1)) THEN
  34 : C
  34 :         CALL LIROBJ ('LISTREEL',IPCURZ,1,IRET)
  35 :         IF(IRET.EQ.0) RETURN
  36 : C
  36 :         CALL LIROBJ ('LISTREEL',IPAXIA,1,IRET0)
  37 :         IF(IRET.EQ.0) RETURN
  38 : C
  38 :         CALL LIROBJ ('MMODEL  ',IPMODL,1,IRET)
  39 :         IF(IRET.EQ.0) RETURN
  40 : C
  40 :         CALL LIROBJ ('MCHAML  ',IPCAR,1,IRET)
  41 :         IF(IRET.EQ.0) RETURN
  42 : C
  42 :         CALL LIRREE (TOL,1,IRET)
  43 :         IF(IRET.EQ.0) RETURN
  44 : C
  44 :         CALL LIRMOT('VERIF',5,iret,0)
  45 :         if (iret.eq.1) zveri=.true.
  46 : C
  46 :         CALL MOCU2D(IPCURZ,IPAXIA,IPMODL,IPCAR,IPEPAX,
  47 :      $       IPMOMZ,TOL,mtable,zveri)
  48 : C
  48 :         if (zveri) Call ecrobj('TABLE', mtable)
  48 :         CALL ECROBJ('LISTREEL',IPEPAX)
  48 :         CALL ECROBJ('LISTREEL',IPMOMZ)
  49 :         
  50 :       ELSE
  51 : C
  51 :         CALL LIROBJ ('LISTREEL',IPCURY,1,IRET)
  52 :         IF(IRET.EQ.0) RETURN
  53 : C
  53 :         CALL LIROBJ ('LISTREEL',IPCURZ,1,IRET)
  54 :         IF(IRET.EQ.0) RETURN
  55 : C
  55 :         CALL LIROBJ ('LISTREEL',IPAXIA,1,IRET0)
  56 :         IF(IRET0.EQ.0) RETURN
  57 : C
  57 :         CALL LIROBJ ('MMODEL  ',IPMODL,1,IRET)
  58 :         IF(IRET.EQ.0) RETURN
  59 : C
  59 :         CALL LIROBJ ('MCHAML  ',IPCAR,1,IRET)
  60 :         IF(IRET.EQ.0) RETURN
  61 : C
  61 :         CALL LIRREE (TOL,1,IRET)
  62 :         IF(IRET.EQ.0) RETURN
  63 : C
  63 :         CALL LIRMOT('VERIF',5,iret,0)
  64 :         if (iret.eq.1) zveri=.true.
  65 :         
  66 : C
  66 :          CALL MOCU3D(IPCURY,IPCURZ,IPAXIA,IPMODL,IPCAR,IPEPAX,
  67 :      $ IPMOMY,IPMOMZ,TOL,mtable,zveri)
  68 : C
  68 :         if (zveri) Call ecrobj('TABLE', mtable)
  68 :         CALL ECROBJ('LISTREEL',IPEPAX)
  68 :         CALL ECROBJ('LISTREEL',IPMOMZ)
  68 :         CALL ECROBJ('LISTREEL',IPMOMY)
  69 : 
  70 : C
  71 :       ENDIF
  72 : C
  73 :       RETURN
  74 :       END
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :  
  89 :  
  90 :  
  91 :  
  92 :  
  93 :  
  94 :  

© Cast3M 2003 - All rights reserved.
Disclaimer