[updated 11.Sep.2008]
Librairie alodyn > Fichier tbarfl.f |
SUBROUTINE TBARFL (CODE
& ,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8
& ,NM9,NV9,MC9,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12
& ,NM13,NV13,MC13,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16
& ,NM17,NV17,MC17,NM18,NV18,MC18,NM19,NV19,MC19,NM20,NV20,MC20)
Auteurs : D.Martin & O.deBayser (Mai 1988)
Derniere modification : D.Martin (15 Octobre 1997)
Version # 1.0.1
Fournit les adresses en rafale de N tableaux ( 1 < N < 21 )
-- Arguments d'entree --
NMi nom du tableau numero i dans la liste d'appel
NVi niveau --------------------------------------
-- Arguments de sortie --
MCi adresse du tableau i ------------------------
CODE chaine des caracteres de code de retour
CHARACTER*(*) CODE
& ,NM1,NM2,NM3,NM4,NM5,NM6,NM7,NM8,NM9,NM10
& ,NM11,NM12,NM13,NM14,NM15,NM16,NM17,NM18,NM19,NM20
INTEGER NV1,NV2,NV3,NV4,NV5,NV6,NV7,NV8,NV9,NV10
& ,NV11,NV12,NV13,NV14,NV15,NV16,NV17,NV18,NV19,NV20
& ,MC1,MC2,MC3,MC4,MC5,MC6,MC7,MC8,MC9,MC10
& ,MC11,MC12,MC13,MC14,MC15,MC16,MC17,MC18,MC19,MC20
INCLUDE 'ALLOC'
INTEGER RF,NIP
CHARACTER PRFXAS*8
COMMON/RAFALE/RF
CHARACTER NWCODE
ENTRY TBAR20 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16,NM17,NV17,MC17
& ,NM18,NV18,MC18,NM19,NV19,MC19,NM20,NV20,MC20)
NWCODE=CODE(1:1)
IF (TBDCST(16).GT.0) THEN
RF=20
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM20,NV20,MC20,CODE(20:20),NWCODE)
ENTRY TBAR19 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16,NM17,NV17,MC17
& ,NM18,NV18,MC18,NM19,NV19,MC19)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=19
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM19,NV19,MC19,CODE(19:19),NWCODE)
ENTRY TBAR18 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16,NM17,NV17,MC17
& ,NM18,NV18,MC18)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=18
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM18,NV18,MC18,CODE(18:18),NWCODE)
ENTRY TBAR17 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16,NM17,NV17,MC17)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=17
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM17,NV17,MC17,CODE(17:17),NWCODE)
ENTRY TBAR16 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15,NM16,NV16,MC16)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=16
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM16,NV16,MC16,CODE(16:16),NWCODE)
ENTRY TBAR15 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14,NM15,NV15,MC15)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=15
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM15,NV15,MC15,CODE(15:15),NWCODE)
ENTRY TBAR14 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13
& ,NM14,NV14,MC14)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=14
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM14,NV14,MC14,CODE(14:14),NWCODE)
ENTRY TBAR13 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12,NM13,NV13,MC13)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=13
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM13,NV13,MC13,CODE(13:13),NWCODE)
ENTRY TBAR12 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11,NM12,NV12,MC12)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=12
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM12,NV12,MC12,CODE(12:12),NWCODE)
ENTRY TBAR11 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10,NM11,NV11,MC11)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=11
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM11,NV11,MC11,CODE(11:11),NWCODE)
ENTRY TBAR10 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9
& ,NM10,NV10,MC10)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=10
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM10,NV10,MC10,CODE(10:10),NWCODE)
ENTRY TBAR9 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8,NM9,NV9,MC9)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=9
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM9,NV9,MC9,CODE(9:9),NWCODE)
ENTRY TBAR8 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7,NM8,NV8,MC8)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=8
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM8,NV8,MC8,CODE(8:8),NWCODE)
ENTRY TBAR7 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6,NM7,NV7,MC7)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=7
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM7,NV7,MC7,CODE(7:7),NWCODE)
ENTRY TBAR6 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5,NM6,NV6,MC6)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=6
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM6,NV6,MC6,CODE(6:6),NWCODE)
ENTRY TBAR5 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4
& ,NM5,NV5,MC5)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=5
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM5,NV5,MC5,CODE(5:5),NWCODE)
ENTRY TBAR4 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3,NM4,NV4,MC4)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=4
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM4,NV4,MC4,CODE(4:4),NWCODE)
ENTRY TBAR3 (CODE,NM1,NV1,MC1,NM2,NV2,MC2,NM3,NV3,MC3)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=3
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM3,NV3,MC3,CODE(3:3),NWCODE)
ENTRY TBAR2 (CODE,NM1,NV1,MC1,NM2,NV2,MC2)
NWCODE=CODE(1:1)
IF (RF.LE.0.AND.TBDCST(16).GT.0) THEN
RF=2
WRITE (TBDCST(16),10000) (PRFXAS(NIP),NIP=1,0,-1),RF,RF
ENDIF
CALL TBADRS (NM2,NV2,MC2,CODE(2:2),NWCODE)
CALL TBADRS (NM1,NV1,MC1,CODE(1:1),NWCODE)
RF=0
10000 FORMAT (A,A,'>TbArfl (Tbar',I2.2,')'
&,T39,', Adresses des ',I2,' tableaux suivants')
END !TbArfl
