C CFL SOURCE CB215821 19/08/01 21:15:09 10279 SUBROUTINE CFL *----------------------------------------------------------------------- * * chapeau de l'opérateur cfl * * appelle la routine clf1.eso qui est aussi appelé par taille et cson * *----------------------------------------------------------------------- * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO CHARACTER*4 MOTCLE(2) DATA MOTCLE /'CSON','TAIL'/ * IRET = 0 IRET1 = 0 IRET2 = 0 IRET3 = 0 IPCHA1 = 0 IPCHA2 = 0 IPCHA3 = 0 * CALL LIROBJ('MMODEL ',IPMODL,1,IRET) CALL ACTOBJ('MMODEL ',IPMODL,1) IF (IRET.EQ.0) RETURN c * * determination des trois option * CALL LIRMOT(MOTCLE,2,IVAL,0) IF (IVAL .EQ. 0 ) THEN * cas du calcul global ICAS = 1 CALL LIROBJ('MCHAML ',IPIN,1,IRET1) CALL ACTOBJ('MCHAML ',IPIN,1) IF (IRET1.EQ.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN * ELSE IF (IVAL .EQ. 1 ) THEN * cas ou la vitesse du son est fournie ICAS = 2 * CALL LIROBJ('MCHAML ',IPIN,1,IRET1) CALL ACTOBJ('MCHAML ',IPIN,1) IF (IRET1.EQ.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN * CALL LIROBJ('MCHAML ',IPIN,0,IRET2) * si les caractéristiques ne sont pas fournies * la taille l'est IF ( IRET2 .EQ. 0) THEN IPCHA2 = IPCHA1 ELSE CALL ACTOBJ('MCHAML ',IPIN,1) CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN ENDIF ELSE IF (IVAL .EQ. 2 ) THEN ICAS = 3 * champ de caractéristiques CALL LIROBJ('MCHAML ',IPIN,1,IRET1) CALL ACTOBJ('MCHAML ',IPIN,1) IF (IRET1.EQ.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN CALL LIROBJ('MCHAML ',IPIN,1,IRET3) CALL ACTOBJ('MCHAML ',IPIN,1) IF (IRET3.EQ.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN ENDIF * * ipcha1 champ de caractéristiques * ipcha2 champ de vitesse du son composante 'cson' * ipcha3 champ de taille du maillage composante 'l' ( et 'l2h' facultatif) * CALL CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS) * * en retour on récupère le champ par élément de composante 'tcfl' * IF ( IPCHA4 .EQ. 0) RETURN * CALL ACTOBJ('MCHAML ',IPCHA4,1) CALL ECROBJ('MCHAML ',IPCHA4) END