C PRE61 SOURCE BECC 11/01/05 21:15:19 6836 SUBROUTINE PRE61() C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE61 C C DESCRIPTION : Voir PRE6 C C Discrete Equations Method C C 2me ordre en espace C C Creation of the MCHAMLs IALPF, IROF, IVITF, IPF, C for the two phases. C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF C C************************************************************************ C C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : Crée le 03.12.2009 C Estension au 3D le 21.12.2010 C C************************************************************************ C IMPLICIT INTEGER(I-N) C C**** Les variables C INTEGER ICOND, IRETOU, MMODEL, ICELL & , IDOMA, ICEN, IFACE, IFACEL, INORM & , IAL1, IGRAL1, ILIAL1 & , IAL2, IGRAL2, ILIAL2 & , IRN1, IGRRN1, ILIRN1 & , IRN2, IGRRN2, ILIRN2 & , IVN1, IGRVN1, ILIVN1 & , IVN2, IGRVN2, ILIVN2 & , IPN1, IGRPN1, ILIPN1 & , IPN2, IGRPN2, ILIPN2 & , IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F C CHARACTER*(4) NOMGRA(27),NOMLIM(9) CHARACTER*(8) MTYPR CHARACTER*(40) MESERR C C**** Les Includes C -INC CCOPTIO INTEGER JGM, JGN -INC SMLMOTS POINTEUR MLMCOM.MLMOTS, MLMVIT.MLMOTS, MLMTEN.MLMOTS C C**** Nom de composantes de gradients (HP. <= 9 composantes) C DATA NOMGRA /'P1DX','P1DY','P1DZ', & 'P2DX','P2DY','P2DZ', & 'P3DX','P3DY','P3DZ', & 'P4DX','P4DY','P4DZ', & 'P5DX','P5DY','P5DZ', & 'P6DX','P6DY','P6DZ', & 'P7DX','P7DY','P7DZ', & 'P8DX','P8DY','P8DZ', & 'P9DX','P9DY','P9DZ'/ C DATA NOMLIM /'P1 ', & 'P2 ', & 'P3 ', & 'P4 ', & 'P5 ', & 'P6 ', & 'P7 ', & 'P8 ', & 'P9 '/ C C**** Initialisation of some segment C JGN=4 JGM=1 SEGINI MLMCOM JGN=4 JGM=IDIM SEGINI MLMVIT JGN=4 JGM=IDIM*IDIM SEGINI MLMTEN C C**** Lecture de l'objet MODELE C ICOND = 1 MTYPR = 'MMODEL ' CALL LIROBJ(MTYPR, MMODEL, ICOND, IRETOU) IF(IERR.NE.0)GOTO 9999 CALL LEKMOD(MMODEL, IDOMA, ICELL) IF(IERR.NE.0)GOTO 9999 C C**** Lecture du MELEME SPG des points CENTRE. C C C CALL LEKTAB(IDOMA,'CENTRE',IP) C C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' C -> la correspondance global des noeuds saut! C C On peut utilizer ACCTAB ou ACMO C MTYPR = 'MAILLAGE' CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) IF(IERR.NE.0)GOTO 9999 C C**** Lecture du MELEME 'FACE' C MTYPR = 'MAILLAGE' CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) IF(IERR.NE.0)GOTO 9999 C C**** Lecture du MELEME 'FACEL' C MTYPR = 'MAILLAGE' CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) IF(IERR.NE.0)GOTO 9999 C C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces C IF(IDIM .EQ. 2)THEN C Que les normales CALL LEKTAB(IDOMA,'XXNORMAF',INORM) IF(IERR .NE. 0) GOTO 9999 MLMVIT.MOTS(1) = 'UX ' MLMVIT.MOTS(2) = 'UY ' CALL QUEPO1(INORM, IFACE, MLMVIT) IF(IERR.NE.0)GOTO 9999 ELSE C Les normales et les tangentes MTYPR = ' ' CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) IF (MTYPR .NE. 'CHPOINT ') THEN CALL MATRAN(IDOMA,INORM) IF(IERR .NE. 0) GOTO 9999 ENDIF MLMTEN.MOTS(1) = 'UX ' MLMTEN.MOTS(2) = 'UY ' MLMTEN.MOTS(3) = 'UZ ' MLMTEN.MOTS(4) = 'RX ' MLMTEN.MOTS(5) = 'RY ' MLMTEN.MOTS(6) = 'RZ ' MLMTEN.MOTS(7) = 'MX ' MLMTEN.MOTS(8) = 'MY ' MLMTEN.MOTS(9) = 'MZ ' CALL QUEPO1(INORM, IFACE, MLMTEN) IF(IERR.NE.0)GOTO 9999 ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C**** Lecture des CHPOINTs alpha ****C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C**** IAL1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IAL1,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IAL1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRAL1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRAL1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRAL1, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIAL1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIAL1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIAL1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** IAL2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IAL2,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IAL2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRAL2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRAL2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRAL2, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIAL2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIAL2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIAL2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C**** Lecture des CHPOINTs rho ****C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C**** RN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IRN1,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IRN1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRRN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRRN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRRN1, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIRN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIRN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIRN1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** IRN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IRN2,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IRN2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRRN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRRN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRRN2, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIRN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIRN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIRN2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C**** Lecture des CHPOINTs vitesse ****C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C**** VN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IVN1,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)='UX ' MLMVIT.MOTS(2)='UY ' IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' CALL QUEPO1(IVN1, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRVN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRVN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMTEN*MOD IF (IDIM .EQ. 2)THEN MLMTEN.MOTS(1)=NOMGRA(1) MLMTEN.MOTS(2)=NOMGRA(2) MLMTEN.MOTS(3)=NOMGRA(4) MLMTEN.MOTS(4)=NOMGRA(5) ELSEIF(IDIM .EQ. 3) THEN MLMTEN.MOTS(1)=NOMGRA(1) MLMTEN.MOTS(2)=NOMGRA(2) MLMTEN.MOTS(3)=NOMGRA(3) MLMTEN.MOTS(4)=NOMGRA(4) MLMTEN.MOTS(5)=NOMGRA(5) MLMTEN.MOTS(6)=NOMGRA(6) MLMTEN.MOTS(7)=NOMGRA(7) MLMTEN.MOTS(8)=NOMGRA(8) MLMTEN.MOTS(9)=NOMGRA(9) ENDIF CALL QUEPO1(IGRVN1, ICEN, MLMTEN) SEGDES MLMTEN IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C C**** Lecture du CHPOINT ILIVN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIVN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMLIM(1) MLMVIT.MOTS(2)=NOMLIM(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3) CALL QUEPO1(ILIVN1, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** VN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IVN2,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)='UX ' MLMVIT.MOTS(2)='UY ' IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' CALL QUEPO1(IVN2, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRVN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRVN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMTEN*MOD IF (IDIM .EQ. 2)THEN MLMTEN.MOTS(1)=NOMGRA(1) MLMTEN.MOTS(2)=NOMGRA(2) MLMTEN.MOTS(3)=NOMGRA(4) MLMTEN.MOTS(4)=NOMGRA(5) ELSEIF(IDIM .EQ. 3) THEN MLMTEN.MOTS(1)=NOMGRA(1) MLMTEN.MOTS(2)=NOMGRA(2) MLMTEN.MOTS(3)=NOMGRA(3) MLMTEN.MOTS(4)=NOMGRA(4) MLMTEN.MOTS(5)=NOMGRA(5) MLMTEN.MOTS(6)=NOMGRA(6) MLMTEN.MOTS(7)=NOMGRA(7) MLMTEN.MOTS(8)=NOMGRA(8) MLMTEN.MOTS(9)=NOMGRA(9) ENDIF CALL QUEPO1(IGRVN2, ICEN, MLMTEN) SEGDES MLMTEN IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C C**** Lecture du CHPOINT ILIVN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIVN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMLIM(1) MLMVIT.MOTS(2)=NOMLIM(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3) CALL QUEPO1(ILIVN2, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C**** Lecture des CHPOINTs rho ****C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C**** PN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IPN1,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IPN1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRPN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRPN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRPN1, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIPN1 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIPN1,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIPN1, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** IPN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IPN2,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)='SCAL' CALL QUEPO1(IPN2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT IGRPN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,IGRPN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMVIT*MOD MLMVIT.MOTS(1)=NOMGRA(1) MLMVIT.MOTS(2)=NOMGRA(2) IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3) CALL QUEPO1(IGRPN2, ICEN, MLMVIT) SEGDES MLMVIT IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C**** Lecture du CHPOINT ILIPN2 C ICOND = 1 MTYPR = 'CHPOINT ' CALL LIROBJ(MTYPR,ILIPN2,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 C Control du CHPOINT: QUEPO1 SEGACT MLMCOM*MOD MLMCOM.MOTS(1)= NOMLIM(1) CALL QUEPO1(ILIPN2, ICEN, MLMCOM) SEGDES MLMCOM IF(IERR .NE. 0)THEN GOTO 9999 ENDIF C C write(*,*) 'Fin qui' C write(*,*) IAL1, IGRAL1, ILIAL1 C write(*,*) IAL2, IGRAL2, ILIAL2 C write(*,*) IRN1, IGRRN1, ILIRN1 C write(*,*) IRN2, IGRRN2, ILIRN2 C write(*,*) IVN1, IGRVN1, ILIVN1 C write(*,*) IVN2, IGRVN2, ILIVN2 C write(*,*) IPN1, IGRPN1, ILIPN1 C write(*,*) IPN2, IGRPN2, ILIPN2 C goto 9999 C CALL PRE611( & ICEN,IFACE,IFACEL,INORM, & IAL1, IGRAL1, ILIAL1, & IAL2, IGRAL2, ILIAL2, & IRN1, IGRRN1, ILIRN1, & IRN2, IGRRN2, ILIRN2, & IVN1, IGRVN1, ILIVN1, & IVN2, IGRVN2, ILIVN2, & IPN1, IGRPN1, ILIPN1, & IPN2, IGRPN2, ILIPN2, & IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F) C SEGSUP MLMCOM SEGSUP MLMVIT SEGSUP MLMTEN C C**** Ecriture de C IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F C MTYPR = 'MCHAML ' CALL ECROBJ(MTYPR,IPN2F) CALL ECROBJ(MTYPR,IPN1F) CALL ECROBJ(MTYPR,IVN2F) CALL ECROBJ(MTYPR,IVN1F) CALL ECROBJ(MTYPR,IRN2F) CALL ECROBJ(MTYPR,IRN1F) CALL ECROBJ(MTYPR,IAL2F) CALL ECROBJ(MTYPR,IAL1F) C 9999 CONTINUE C RETURN END