C+++++PARs C----------------------------------------------------------------------- MODULE PARs ! ELFO_DGS : CENTRALE PARAMETRICA C----------------------------------------------------------------------- PARAMETER(MTTT=2000) ! max num gruppi termici PARAMETER(MTTC=0100) ! max num tecnologie termiche PARAMETER(MTCP=0050) ! max num combustibili principali PARAMETER(MTCL=02*MTTT+MTCP) ! max num combustibili localizzati PARAMETER(MTCT=0030) ! max num contratti termici PARAMETER(MDCT=0020) ! max num decenni date inst.gr.term. PARAMETER(MHHS=0300) ! max num centrali idriche s+p PARAMETER(MHHF=0050) ! max num centrali idriche flu PARAMETER(MBES=0030) ! max num batterie PARAMETER(MGGG=0366) ! max num giorni programmazione PARAMETER(MZZZ=0080) ! max num zone di rete PARAMETER(MEMX=MZZZ) ! max num equivalenti import/export PARAMETER(MLLL=02*(MZZZ-01)) ! max num linee di trasporto PARAMETER(MSPD=0200) ! max num societa' di produzione PARAMETER(MEQT=0200) ! max num tipi di gen.equivalenti PARAMETER(MORE=0024*MGGG) ! max num ore di programmazione PARAMETER(MINP=0014) ! numero moduli input BIN C----------------------------------------------------------------------- PARAMETER(MQZZ=MZZZ+01) PARAMETER(MQPD=MSPD+01) PARAMETER(MTOT=MTTT+MHHS+MBES+MHHF) PARAMETER(MHHH=MHHS+MHHF) PARAMETER(MDGS=100000) C----------------------------------------------------------------------- PARAMETER(MHTZ=04*(MZZZ+MSPD))! max num combinazioni zona/societa' PARAMETER(MOUT=0049) ! numero files uscita OUT_*.csv PARAMETER(MMSD=0025) ! numero files uscita OUT_*.csv MSD PARAMETER(MCSV=0240) ! numero max colonne uscite orarie PARAMETER(MCSB=0150) ! numero max colonne uscite bid-up C----------------------------------------------------------------------- PARAMETER(MCL=2002) ! massimo numero di campi leggibili PARAMETER(MCH=MCL*10+02) ! max lungh[B] del formato lettura C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++HFOR C----------------------------------------------------------------------- MODULE HFOR C----------------------------------------------------------------------- USE PARs C....................................................................... INTEGER (0004) ITF(MCL),LCL(MCL),MCF,NHF,NCL,LSTP,NSX,IR,IRIGA INTEGER (0004) ICS(MCL) CHARACTER(0032) NOHF CHARACTER(0072) HSTP CHARACTER( MCH) HFOX,FOXF,FOXL C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++NOMD C----------------------------------------------------------------------- MODULE NOMD C----------------------------------------------------------------------- INTEGER (0004) LCDIR(30) CHARACTER(0004) QUA CHARACTER(1000) HCDIR(30) C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++TCPU C----------------------------------------------------------------------- MODULE TCPU C----------------------------------------------------------------------- INTEGER (0004) IDATE(60),MTCP0,MTCP1,IDEXE C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++IN01 C----------------------------------------------------------------------- MODULE IN01 C----------------------------------------------------------------------- USE PARs C----------------------------------------------------------------------- INTEGER (0004) NG,NO,IDATI,IDATF,NSP,NSQ,NQZ,NCB,NTB,ILSW,IDSW INTEGER (0004) NTE,NCT,NTT,NXP,NQX,NCH,NFL,NCS,NCP,NBS,NLT,NXB INTEGER (0004) NHH,NZ,NL,NZZ,ITTS(MORE,MTTT),ISLT(MZZZ) REAL (0004) PHLT(MORE,MZZZ),S(MTTT),T(MLLL),U(MZZZ) CHARACTER(0016) ICASO CHARACTER(0040) HTITX CHARACTER(0064) HTITO C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++MVAR C----------------------------------------------------------------------- MODULE MVAR C----------------------------------------------------------------------- INTEGER (0004) NOU,NFC,IFOD,ISTW,IMSW,KEYOK,IPRW,MESX,MESY INTEGER (0004) IFUNZIONE,IQGW,KL CHARACTER(0001) TS CHARACTER(0008) HRND CHARACTER(0020) HDATE CHARACTER(0032) HVERS CHARACTER(0100) HERRN CHARACTER(0128) HCASO(03) CHARACTER(1000) HERRD C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: END C+++++XXXX C----------------------------------------------------------------------- PROGRAM XXXX ! REDAZIONE USCITE DIGSILENT DI ELFO_ITA/EUR C----------------------------------------------------------------------- USE HFOR;USE NOMD;USE TCPU;USE IN01;USE MVAR C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C------------------- MAIN: DEFINIZIONE ALLOCABILI I / PIATTAFORMA INPBIN INTEGER (0004),ALLOCATABLE :: IDATA(:),IHPV(:),IZQX(:),IQPZ(:,:) INTEGER (0004),ALLOCATABLE :: ITITB(:),ISCT(:),IDST(:),ICCT(:) INTEGER (0004),ALLOCATABLE :: IZTT(:),NGI(:),NGF(:),ICCH(:) INTEGER (0004),ALLOCATABLE :: ING(:),NSGCT(:,:),NSMCT(:,:) INTEGER (0004),ALLOCATABLE :: ITICT(:),ISTT(:,:),NCTT(:,:) INTEGER (0004),ALLOCATABLE :: ICBT(:,:,:),ICTT(:,:),IMCT(:,:) INTEGER (0004),ALLOCATABLE :: IZCH(:),ISCH(:),IZFL(:),ISFL(:) INTEGER (0004),ALLOCATABLE :: IKTT(:),IHCH(:),IHFL(:),ML(:,:) INTEGER (0004),ALLOCATABLE :: IDTT(:,:),ISTA(:,:),IESE(:,:) INTEGER (0004),ALLOCATABLE :: IZXP(:),IZHH(:),IMAT(:),ICBQZ(:) INTEGER (0004),ALLOCATABLE :: IPRT(:),IMZZ(:,:),ICCPZ(:),IDIT(:) INTEGER (0004),ALLOCATABLE :: NXTZ(:,:),IZBS(:),ISBS(:),IZLT(:) INTEGER (0004),ALLOCATABLE :: MESG(:),MES1,MES2,MESI,MESF C------------------- MAIN: DEFINIZIONE ALLOCABILI R / PIATTAFORMA INPBIN REAL (0004),ALLOCATABLE :: POCTB(:),EMFTB(:,:),RIPRZ(:) REAL (0004),ALLOCATABLE :: SBPQ(:,:),BDTT(:,:),GQTZ(:,:,:,:) REAL (0004),ALLOCATABLE :: DCGCT(:,:,:),DCMCT(:,:,:),DSTT(:,:) REAL (0004),ALLOCATABLE :: CCMB(:,:,:),CLOG(:,:,:),CETS(:,:,:) REAL (0004),ALLOCATABLE :: CN2T(:,:,:),CN1T(:,:,:),CN0T(:,:,:) REAL (0004),ALLOCATABLE :: PCBT(:,:,:),PXTT(:,:),PRMT(:,:) REAL (0004),ALLOCATABLE :: CNCB(:,:),CNTS(:,:),CMCT(:,:) REAL (0004),ALLOCATABLE :: PXDT(:,:),PHTT(:,:),PMTT(:,:) REAL (0004),ALLOCATABLE :: CXCT(:,:),CMCB(:,:),CXCB(:,:) REAL (0004),ALLOCATABLE :: CMTS(:,:),CXTS(:,:),VHCH(:,:) REAL (0004),ALLOCATABLE :: PRXTT(:,:),PRXTP(:,:),CCCQZ(:) REAL (0004),ALLOCATABLE :: TRHL(:,:),CHTZ(:,:),CTVD(:),PZST(:) REAL (0004),ALLOCATABLE :: CAVT(:,:),SBPT(:,:),SBCH(:,:) REAL (0004),ALLOCATABLE :: CLGCT(:,:,:),CLMCT(:,:,:),LHTR(:,:) REAL (0004),ALLOCATABLE :: PHHH(:,:,:),PHCH(:,:,:),RISE(:,:,:) REAL (0004),ALLOCATABLE :: PMXP(:,:),PHXP(:,:),PXXP(:,:) REAL (0004),ALLOCATABLE :: PRXP(:,:),TRML(:,:),TRXL(:,:) REAL (0004),ALLOCATABLE :: PXCH(:,:),PHFL(:,:),PTTX(:) REAL (0004),ALLOCATABLE :: PMAT(:,:,:),PHQX(:,:),CECQZ(:) REAL (0004),ALLOCATABLE :: ADUE(:,:),AUNO(:,:),AZER(:,:) REAL (0004),ALLOCATABLE :: VHBS(:,:),PHBS(:,:,:),SBBS(:,:) REAL (0004),ALLOCATABLE :: CT2T(:,:,:),CT1T(:,:,:),CT0T(:,:,:) REAL (0004),ALLOCATABLE :: PXBS(:,:) REAL (0008),ALLOCATABLE :: PINT(:,:),PMTC(:,:),PNON(:,:) C------------------- MAIN: DEFINIZIONE ALLOCABILI H / PIATTAFORMA INPBIN CHARACTER(0012),ALLOCATABLE :: HDATA(:) CHARACTER(0016),ALLOCATABLE :: HCODZ(:),HCODS(:),HCDCB(:),HTECT(:) CHARACTER(0016),ALLOCATABLE :: HCDQZ(:),HCBQZ(:),HCDTB(:),HCDFL(:) CHARACTER(0016),ALLOCATABLE :: HCDTT(:),HAGGZ(:),HAGPZ(:),HCDXB(:) CHARACTER(0016),ALLOCATABLE :: HCODL(:),HCDHH(:),HTPHH(:),HCDBS(:) CHARACTER(0016),ALLOCATABLE :: HCDCT(:),HCDXP(:),HCDLT(:),NOMST(:) CHARACTER(0016),ALLOCATABLE :: HGMZ(:,:),HCDCH(:) CHARACTER(0040),ALLOCATABLE :: HFILN(:,:),HFINP(:,:) C---------------------------------------- MAIN: DEFINIZIONE ALLOCABILI I INTEGER (0004),ALLOCATABLE :: ISMZ(:),NZST(:),ISTZ(:),INDQJ(:) INTEGER (0004),ALLOCATABLE :: NTTZ(:),NBSZ(:),ITTZ(:,:) INTEGER (0004),ALLOCATABLE :: NQXZ(:),NTRZ(:),NLTZ(:),NXPZ(:) INTEGER (0004),ALLOCATABLE :: ITRZ(:,:),ILTZ(:,:),IXPZ(:,:) INTEGER (0004),ALLOCATABLE :: ITTC(:,:),IBSZ(:,:),IQXZ(:,:) INTEGER (0004),ALLOCATABLE :: IHTZ(:),IPHZ(:,:),NPHZ(:) C---------------------------------------- MAIN: DEFINIZIONE ALLOCABILI R REAL (0004),ALLOCATABLE :: FTRZ(:,:),PHTZ(:,:) C---------------------------------------- MAIN: DEFINIZIONE ALLOCABILI H CHARACTER(0004),ALLOCATABLE :: HDIS(:,:),HSTT(:,:) CHARACTER(0004),ALLOCATABLE :: HDSP(:,:) CHARACTER(0012),ALLOCATABLE :: HFOD(:,:) CHARACTER(0016),ALLOCATABLE :: HCPRZ(:,:),HCDMZ(:),HCDTS(:) CHARACTER(0016),ALLOCATABLE :: HSLZ(:,:),HCDSZ(:) CHARACTER(0080),ALLOCATABLE :: HINIF(:),HFINF(:) CHARACTER(MDGS),ALLOCATABLE :: HFS,HFT C--------------------------------------------- MAIN: DEFINIZIONI INTERNE INTEGER (0004) ICDS(00:01,01),IVID,LVID,LVIDEO REAL (0004) E,ERRRW CHARACTER(0003) HMC CHARACTER(0008) HRLNG(02),HCOD CHARACTER(0032) HFILX CHARACTER(0036) HFOUT C----------------------------------------------------------------------- DATA HRLNG/'ITALIANO','ENGLISH '/ C:::::::::::::::::::::::::::::::: ALLOCAZIONE I/R/H - PIATTAFORMA INPBIN ALLOCATE (IDATA(366),IHPV(MORE),IZQX(MEQT),IQPZ(MZZZ,MEQT)) ALLOCATE (ITITB(MTCL),ISCT(MTTT),IDST(MTTT),ICCT(MTTT),IZTT(MTTT)) ALLOCATE (NGI(00:25),NGF(00:25),ICCH(MHHS),ING(MORE),ITICT(MTCT)) ALLOCATE (NSGCT(24,MTCT),NSMCT(24,MTCT),ISTT(MORE,MTTT),MESI,MESF) ALLOCATE (NCTT(MORE,MTTT),ICBT(MORE,MTTT,02),ICTT(MORE,MTTT)) ALLOCATE (IMCT(MORE,MTTT),IZCH(MHHS),ISCH(MHHS),IZFL(MHHF)) ALLOCATE (ISFL(MHHF),IKTT(MTTT),IHCH(MHHS),IHFL(MHHF),ML(MLLL,05)) ALLOCATE (IDTT(MORE,MTTT),ISTA(MORE,MTTT),IESE(MORE,MTTT)) ALLOCATE (IZXP(MEMX),IZHH(MHHH),IMAT(06),ICBQZ(MEQT),IPRT(MTTT)) ALLOCATE (IMZZ(MORE,MZZZ),ICCPZ(MZZZ),IDIT(MTTT),NXTZ(MORE,MZZZ)) ALLOCATE (IZBS(MBES),ISBS(MBES),IZLT(MZZZ),MESG(MGGG),MES1,MES2) ALLOCATE (POCTB(MTCL),EMFTB(MTCL,04),RIPRZ(MZZZ),SBPQ(MORE,MZZZ)) ALLOCATE (BDTT(MORE,MTTT),GQTZ(MORE,MEQT,02,MQZZ),DSTT(MORE,MTTT)) ALLOCATE (DCGCT(24,MTCT,00:05),DCMCT(24,MTCT,00:05),CCCQZ(MEQT)) ALLOCATE (CCMB(MORE,MTTT,02),CLOG(MORE,MTTT,02),PXTT(MORE,MTTT)) ALLOCATE (CETS(MORE,MTTT,02),CN2T(MORE,MTTT,02),PRMT(MORE,MTTT)) ALLOCATE (CN0T(MORE,MTTT,02),CN1T(MORE,MTTT,02),CNCB(MORE,MTTT)) ALLOCATE (PCBT(MORE,MTTT,02),CNTS(MORE,MTTT),CMCT(MORE,MTTT)) ALLOCATE (PXDT(MORE,MTTT),PHTT(MORE,MTTT),PMTT(MORE,MTTT)) ALLOCATE (CXCT(MORE,MTTT),CMCB(MORE,MTTT),CXCB(MORE,MTTT)) ALLOCATE (CMTS(MORE,MTTT),CXTS(MORE,MTTT),VHCH(00:MORE,MHHS)) ALLOCATE (PRXTT(MORE,00:MZZZ),PRXTP(MORE,00:MZZZ),TRHL(MORE,MLLL)) ALLOCATE (CHTZ(MORE,MQZZ),CTVD(MGGG),PZST(MGGG),CAVT(MORE,MTTT)) ALLOCATE (SBPT(MORE,MTTT),SBCH(MORE,MHHS),CLGCT(24,MTCT,00:05)) ALLOCATE (CLMCT(24,MTCT,00:05),LHTR(MORE,MLLL),PHHH(MORE,MHHH,03)) ALLOCATE (PHCH(MORE,MHHS,03),RISE(MORE,MQZZ,07),PMXP(MORE,MEMX)) ALLOCATE (PHXP(MORE,MEMX),PXXP(MORE,MEMX),PRXP(MORE,MEMX)) ALLOCATE (TRML(MORE,MLLL),TRXL(MORE,MLLL),PTTX(MTTT),CECQZ(MEQT)) ALLOCATE (PXCH(MORE,MHHS),PHFL(MORE,MHHF),PMAT(MORE,MZZZ,04)) ALLOCATE (ADUE(MORE,MTTT),AUNO(MORE,MTTT),AZER(MORE,MTTT)) ALLOCATE (PHQX(MORE,MEQT),VHBS(00:MORE,MBES),PHBS(MORE,MBES,03)) ALLOCATE (PXBS(MORE,MBES),SBBS(MORE,MBES),CT0T(MORE,MTTT,02)) ALLOCATE (CT2T(MORE,MTTT,02),CT1T(MORE,MTTT,02),HDATA(366)) ALLOCATE (PNON(00:MORE,MQZZ),PINT(00:MORE,MQZZ),HCODZ(00:MQZZ)) ALLOCATE (PMTC(00:MORE,MQZZ),HCODS(MQPD),HCDCB(00:MTCL)) ALLOCATE (HTECT(MTTT),HCDQZ(MEQT),HCBQZ(MEQT),HCDTB(MTCL)) ALLOCATE (HCDFL(MHHF),HCDTT(MTTT),HAGGZ(MQZZ),HAGPZ(MZZZ)) ALLOCATE (HCDXB(MTCL),HCODL(MLLL),HCDHH(MHHH),HTPHH(MHHH)) ALLOCATE (HCDBS(MBES),HCDCT(MTCT),HCDXP(MEMX),HCDLT(MZZZ)) ALLOCATE (NOMST(MZZZ),HGMZ(MORE,MZZZ),HCDCH(MHHS),HFINP(MINP,03)) ALLOCATE (HFILN(MINP,00:25)) C::::::::::::::::::::::::::::::::::::::::::::::: MAIN: ALLOCAZIONE I/R/H ALLOCATE (HDIS(00:01,03),HSTT(0:2,03),HDSP(00:06,03),HFOD(04,03)) ALLOCATE (HINIF(03),HFINF(03),INDQJ(MEQT),ISTZ(MQZZ),ISMZ(MQZZ)) ALLOCATE (HCPRZ(06,03),NZST(MZZZ),HCDMZ(MZZZ),HCDTS(MZZZ)) Cooooooooooooooooooooooooooooooooooooooooooo Formati Intestazione Output ALLOCATE (HSLZ(17,03)) Cooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo HDIS(00,01)='INDI' ; HDIS(00,02)='UNAV' ; HDIS(00,03)=' ' HDIS(01,01)='DISP' ; HDIS(01,02)='AVAI' ; HDIS(01,03)=' ' HSTT(00,01)='ESUB' ; HSTT(00,02)='EXUB' ; HSTT(00,03)=' ' HSTT(01,01)='CARI' ; HSTT(01,02)='LOAD' ; HSTT(01,03)=' ' HSTT(02,01)='RISE' ; HSTT(02,02)='RESE' ; HSTT(02,03)=' ' HDSP(00,01)='FERM' ; HDSP(00,02)='STOP' ; HDSP(00,03)=' ' HDSP(01,01)='AMIN' ; HDSP(01,02)='AMIN' ; HDSP(01,03)=' ' HDSP(02,01)='BMOD' ; HDSP(02,02)='BMOD' ; HDSP(02,03)=' ' HDSP(03,01)='CMAX' ; HDSP(03,02)='CMAX' ; HDSP(03,03)=' ' HDSP(04,01)='DMIN' ; HDSP(04,02)='DMIN' ; HDSP(04,03)=' ' HDSP(05,01)='EMOD' ; HDSP(05,02)='EMOD' ; HDSP(05,03)=' ' HDSP(06,01)='FMAX' ; HDSP(06,02)='FMAX' ; HDSP(06,03)=' ' C....................................................................... HCPRZ(01,01)='Prezzo mercato ' ; HCPRZ(01,02)='Market price ' HCPRZ(02,01)='Certific.verdi ' ; HCPRZ(02,02)='Green certific. ' HCPRZ(03,01)='Marginale Em.CO2' ; HCPRZ(03,02)='Marginal CO2 Pol' HCPRZ(04,01)='Marginale Comb. ' ; HCPRZ(04,02)='Marginal Fuel ' HCPRZ(05,01)='Medio Combustib.' ; HCPRZ(05,02)='Medium Fuel ' HCPRZ(06,01)='Strategia ' ; HCPRZ(06,02)='Market Strategy ' HCPRZ(01,03)=' ' HCPRZ(02,03)=' ' HCPRZ(03,03)=' ' HCPRZ(04,03)=' ' HCPRZ(05,03)=' ' HCPRZ(06,03)=' ' C....................................................................... HSLZ(01,01)='Selez. ' ; HSLZ(01,02)='Select. ' HSLZ(02,01)='Nome Gr. ' ; HSLZ(02,02)='UnitName ' HSLZ(03,01)='Zona ' ; HSLZ(03,02)='Zone ' HSLZ(04,01)='Societa ' ; HSLZ(04,02)='Company ' HSLZ(05,01)='Tecnol. ' ; HSLZ(05,02)='Tecnol. ' HSLZ(06,01)='Combust. ' ; HSLZ(06,02)='Fuel ' HSLZ(07,01)='Centrale ' ; HSLZ(07,02)='PowerPlant ' HSLZ(08,01)='Tipo ' ; HSLZ(08,02)='Type ' HSLZ(09,01)='Gen/Pomp ' ; HSLZ(09,02)='Gen/Pump ' HSLZ(10,01)='Gsf/Gp/P ' ; HSLZ(10,02)='Gsf/Gp/P ' HSLZ(11,01)='LINEA EQ ' ; HSLZ(11,02)='EQUIV.LINE ' HSLZ(12,01)='EQ.IM/EX ' ; HSLZ(12,02)='IMP/EXP.EQ. ' HSLZ(13,01)='TERM/IDR ' ; HSLZ(13,02)='THERM/HYDRO ' HSLZ(14,01)='Aggregato ' ; HSLZ(14,02)='Aggregate ' HSLZ(15,01)='Zona/Aggr ' ; HSLZ(15,02)='Zone/Aggr ' HSLZ(16,01)='Contratti ' ; HSLZ(16,02)='Contracts ' HSLZ(17,01)='Comp.prez. ' ; HSLZ(17,02)='Pr.compon. ' HSLZ(01,03)=' ' HSLZ(02,03)=' ' HSLZ(03,03)=' ' HSLZ(04,03)=' ' HSLZ(05,03)=' ' HSLZ(06,03)=' ' HSLZ(07,03)=' ' HSLZ(08,03)=' ' HSLZ(09,03)=' ' HSLZ(10,03)=' ' HSLZ(11,03)=' ' HSLZ(12,03)=' ' HSLZ(13,03)=' ' HSLZ(14,03)=' ' HSLZ(15,03)=' ' HSLZ(16,03)=' ' HSLZ(17,03)=' ' C....................................................................... HFOD(01,01)='aaaammgg ' ; HFOD(01,02)='yyyymmdd ' HFOD(02,01)='aaaa/mm/gg ' ; HFOD(02,02)='yyyy/mm/dd ' HFOD(03,01)='gg/mm/aa ' ; HFOD(03,02)='dd/mm/yy ' HFOD(04,01)='gg/mm/aaaa ' ; HFOD(04,02)='dd/mm/yyyy ' HFOD(01,03)=' ' HFOD(02,03)=' ' HFOD(03,03)=' ' HFOD(04,03)=' ' C:::::::::::::::::::::::::::::::: CHIAVE IN CASO DI RIMOZIONE PROTEZIONI KEYOK=52 C.................... STRINGA CONTROLLO DI AUTORIZZAZIONE ALL'ESECUZIONE HRND=' ' C...+....1....+....2....+....3....+....4....+.... VERSIONE DEL PROGRAMMA C ....+....1....+....2....+....3.. HVERS='Versione 10.01 20240709 21:55 ' C........... ....+....1....+....2....+....3.. ... DATA/ORA DI ESECUZIONE CALL GETDAT(IA,IM,IG) CALL GETTIM(IH,MI,IS,IC) IDEXE=IA*10000+IM*100+IG CALL CALEND(IDEXE,09,IDATE) HDATE=' ' C............................................................. STARTTIME MTCP0=360000*IH+6000*MI+100*IS+IC C........................ CONFIGURAZIONE DIRECTORIES MODULI INPUT/OUTPUT CALL CONFIG('ELFO++.CFG') C.......... SELEZIONE_OUTPUT: LINGUA DI REDAZIONE 01=ITALIANO 02=INGLESE KL=01 CALL OPFILE(01,15,'SELEZIONE_OUTPUT.CSV','UNKNOWN',IERR ) NN=INFOR('15SELEZIONE_OUTPUT ............') C....................................................................... IF(NN >00)THEN IL=00 II=00 DO WHILE (II 00)KL=IL ENDDO CLOSE(UNIT=15) ELSE CLOSE(UNIT=15) CALL DEFILE(01,'SELEZIONE_OUTPUT.CSV') ENDIF C........................................................ IDENTIFICATIVA WRITE(HCASO(01), '(''PROGRAMMA ELFO_DGS '',A31,T105,I4.4,2I2.2,X, &I2.2,1H:,I2.2,10H - Pag.000)') HVERS,IA,IM,IG,IH,MI WRITE(HCASO(02), '(''ELFO_DGS PROGRAM '', A31,T105,I4.4,2I2.2,X, &I2.2,1H:,I2.2,10H - Pag 000)') HVERS,IA,IM,IG,IH,MI WRITE(HCASO(03), '('' '',A31,T105,I4.4,2I2.2,X, &I2.2,1H:,I2.2,10H - )') HVERS,IA,IM,IG,IH,MI C......................................................... APERTURA .LOG NOU=10 CALL OPFILE (02,NOU,'ELFO_DGS.LOG','REPLACE',IERR) C.......................................................... FRONTESPIZIO CALL VLNPAG(02) C................................ CODICE DI ATTIVAZIONE DELLE PROTEZIONI HMC='111' ! DEFAULT = tutte le protezioni C....................................................................... DO IJ=01,02 CALL GETARG(IJ,HCOD) IF(LEN_TRIM(HCOD)==03)THEN HMC=HCOD(01:03) DO IK=01,03 ICH=ICHAR(HMC(IK:IK)) IF(INTIN(048,ICH,049)==00)E=ERRRW('ELFO_DGS',00,'023') ENDDO ENDIF ENDDO C..................................... STARTTIME /CONTROLLO PRESENZA BIN CALL GECONF (HFINP,HFILN) Ciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii INGRESSO BIN DA ELFO++C CALL INPBIN (IDATA,HDATA,HCODZ,HCODS,IHPV,HCDQZ,HTECT,HCDCB, & HFILN,HCBQZ,HCDTB,HCDFL,HGMZ,IZQX,IQPZ, & ITITB,POCTB,EMFTB,HCDTT,IZTT,ISCT,IDST,ICCT,HAGGZ, & NGI,NGF,ING,HAGPZ,RIPRZ,SBPQ,BDTT,GQTZ,HCDCH,ICCH, & DCGCT,NSGCT,DCMCT,NSMCT,ITICT,ISTT,CCMB,CLOG,CETS, & CN2T,CN1T,CN0T,ICBT,PCBT,NCTT,DSTT,PXDT,PHTT,PMTT, & PXTT,PRMT,ICTT,CNCB,CNTS,CMCT,CXCT,CMCB,CXCB,CMTS, & CXTS,PMTC,VHCH,PRXTT,PNON,TRHL,PINT,PRXTP,HFINP, & CCCQZ,IZCH,ISCH,IZFL,ISFL,HCODL,HCDHH,CHTZ,HTPHH, & IMCT,IKTT,CTVD,PZST,CAVT,SBPT,SBCH,HCDCT,CLGCT, & CLMCT,PHHH,IHCH,IHFL,ML,TRML,TRXL,RISE,IDTT,ISTA, & IESE,HCDXP,IZXP,PMXP,PHXP,PXXP,PRXP,PHCH,PXCH, & PHFL,PTTX,IZHH,IMAT,PMAT,HCDXB,NOMST,ICBQZ,IPRT, & ADUE,AUNO,AZER,IMZZ,ICCPZ,IDIT,NXTZ,PHQX,CECQZ, & HCDBS,IZBS,ISBS,VHBS,PHBS,SBBS,CT2T,CT1T,CT0T, & MESG,PXBS,LHTR,MES1,MES2,MESI,MESF,HCDLT,IZLT) Ciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii IF(KL==01)HCODZ(000)='SISTEMA ' IF(KL==02)HCODZ(000)='SYSTEM ' IF(KL==03)HCODZ(000)=' ' IF(KL==01)HCODZ(NZZ)='TOTALE_ZONE ' IF(KL==02)HCODZ(NZZ)='TOTAL_ZONES ' IF(KL==03)HCODZ(NZZ)=' ' LTT=MAX(01,NTT);LHH=MAX(01,NHH);LXB=MAX(01,NXB);LBS=MAX(01,NBS) Ciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii SELEZIONE OUTPUT *.CSV C C................................................... NOMENCLATURA OUTPUT WRITE(HINIF(01),'(''REDAZIONE IN CORSO '', 61(1H.))') WRITE(HINIF(02),'(''EDITING IN PROGRESS '', 60(1H.))') WRITE(HINIF(03),'('' '', 61(1H.))') WRITE(HFINF(01),'(''REDAZIONE ESEGUITA '', 61(1H.))') WRITE(HFINF(02),'(''EDITING COMPLETED '', 62(1H.))') WRITE(HFINF(03),'('' '', 61(1H.))') C:::::::::::::::::::::::::::::::::: NUMERO STATI (NTS) MULTIZONALI (NMZ) NMZ=00;NTS=00;NZST(01:NZ)=00 DO IZ=01,NZ ITS=ICODE(HCDTS,NTS,NOMST(IZ)) IF(ITS==00)THEN NTS=NTS+01 HCDTS(NTS)=NOMST(IZ) ITS=NTS ENDIF MM=NZST(ITS)+01 NZST(ITS)=MM IF (MM==02)THEN NMZ=NMZ+01 HCDMZ(NMZ)=NOMST(IZ) ELSEIF(MM==NZ)THEN NMZ=00 ENDIF ENDDO C:.:.:.:.:.:.:.:.:.:.:.:. IDENTIFICATORI ZONE +TOTALE +STATI_MULTIZONALI ALLOCATE (HCDSZ(NZZ+NMZ)) C....................................................................... HCDSZ(01:NZZ)=HCODZ(01:NZZ) IMZ=00 DO WHILE (IMZ 00)THEN NN=NQXZ(IZ)+01 IQXZ(NN,IZ)=IQZ NQXZ(IZ)=NN ENDIF ENDDO ENDDO C.................................................................... 06 ALLOCATE(ITRZ(00:NL,NZ),FTRZ(00:NL,NZ),NTRZ(NZ)) NTRZ(01:NZ)=00 IL=00 DO WHILE (IL ,4H.CSV,<17-LZ>X)') & IDATA(01)/10000,HCODZ(IZ) CALL DSPRED(HFOUT,00) CALL OPFILE(03,15,HFOUT,'REPLACE',IERR) C....................................................................... N0=01;N1=NTTZ(IZ);N2=IHTZ(IZ);N3=NPHZ(IZ);N4=NBSZ(IZ);N5=NQXZ(IZ) N6=NTRZ(IZ);N7=NLTZ(IZ);N8=NXPZ(IZ);IK=14 C....................................................................... WRITE(HFS(01:IK),'(14H Data ;hh;)') WRITE(HFT(01:IK),'(14H ; ;)') CALL HSTRP(HFS,HFT,N0,'Carico ','totale ',ICDS,001,01,01,IK) CALL HSTRP(HFS,HFT,N1, HCDTT, 'UpTer ',ITTZ,NTT,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N2,'Gen.Idr','(s+f) ',ICDS,001,01,01,IK) CALL HSTRP(HFS,HFT,N3, HCDCH, 'UpIdr(p)',IPHZ,NCP,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N4, HCDBS, 'Bess ',IBSZ,NBS,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N5, HCDQZ, 'GenEq ',IQXZ,NQZ,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N6, HCODL, 'Linea ',ITRZ, NL,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N7, HCDLT, 'GenH2 ',ILTZ,NLT,NZ,IZ,IK) CALL HSTRP(HFS,HFT,N8, HCDXP, 'ImpExp ',IXPZ,NXP,NZ,IZ,IK) WRITE(15,'(A)')HFS;WRITE(15,'(A)')HFT C....................................................................... T(01:N6)=FTRZ(01:N6,IZ) C....................................................................... DO IO=01,NO IG=ING(IO);IH=MOD(IO-01,24)+01;IK=14 WRITE(HFS(01:IK),'(A10,1H;,I2.2,1H;)') HDATA(IG),IH CALL HSTRQ(HFS,U,N0,CHTZ(1,1 ),MORE,MQZZ,ITTC,001,NZ,IO,IZ,IK) CALL HSTRQ(HFS,S,N1,PHTT(1,1 ),MORE,MTTT,ITTZ,NTT,NZ,IO,IZ,IK) CALL HSTRQ(HFS,S,N2,PHTZ(1,1 ),NO , NZ,ITTC,001,NZ,IO,IZ,IK) CALL HSTRQ(HFS,S,N3,PHCH(1,1,3 ),MORE,MHHS,IPHZ,NCP,NZ,IO,IZ,IK) CALL HSTRQ(HFS,S,N4,PHBS(1,1,3 ),MORE,MBES,IBSZ,NBS,NZ,IO,IZ,IK) CALL HSTRQ(HFS,S,N5,GQTZ(1,1,2,IZ),MORE,MEQT,IQXZ,NQZ,NZ,IO,IZ,IK) CALL HSTRQ(HFS,T,N6,TRHL(1,1 ),MORE,MLLL,ITRZ, NL,NZ,IO,IZ,IK) CALL HSTRQ(HFS,U,N7,PHLT(1,1 ),MORE,MZZZ,ILTZ,NLT,NZ,IO,IZ,IK) CALL HSTRQ(HFS,U,N8,PHXP(1,1 ),MORE,MEMX,IXPZ,NXP,NZ,IO,IZ,IK) WRITE(15,'(A)')HFS ENDDO C....................................................................... CLOSE(UNIT=15) CALL DSPRED(HFOUT,01);CALL IRVID(IVID,LVID) C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ENDDO Ciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii CALL SALTO('01 ') C:::::::::::::::::::::::: MAIN: DEALLOCAZIONE I/R/H / PIATTAFORMA INPBIN DEALLOCATE (IDATA,IHPV,IZQX,IQPZ,ITITB,ISCT,IDST,ICCT,IZTT,NGI) DEALLOCATE (NGF,ICCH,ING,ITICT,NSGCT,NSMCT,ISTT,MESI,MESF,NCTT) DEALLOCATE (ICBT,ICTT,IMCT,IZCH,ISCH,IZFL,ISFL,IKTT,IHCH,IHFL,ML) DEALLOCATE (IDTT,ISTA,IESE,IZXP,IZHH,IMAT,ICBQZ,IPRT,IMZZ,ICCPZ) DEALLOCATE (IDIT,NXTZ,IZBS,ISBS,IZLT,MESG,MES1,MES2,POCTB,EMFTB) DEALLOCATE (RIPRZ,SBPQ,BDTT,GQTZ,DSTT,DCGCT,DCMCT,CCCQZ,CCMB,CLOG) DEALLOCATE (PXTT,CETS,CN2T,PRMT,CN0T,CN1T,CNCB,PCBT,CNTS,CMCT) DEALLOCATE (PXDT,PHTT,PMTT,CXCT,CMCB,CXCB,CMTS,CXTS,VHCH,PRXTT) DEALLOCATE (PRXTP,TRHL,CHTZ,CTVD,PZST,CAVT,SBPT,SBCH,CLGCT,CLMCT) DEALLOCATE (LHTR,PHHH,PHCH,RISE,PMXP,PHXP,PXXP,PRXP,TRML,TRXL) DEALLOCATE (PTTX,CECQZ,PXCH,PHFL,PMAT,ADUE,AUNO,AZER,PHQX,VHBS) DEALLOCATE (PHBS,PXBS,SBBS,CT2T,CT1T,CT0T,HDATA,PNON,PINT,HCODZ) DEALLOCATE (PMTC,HCODS,HCDCB,HTECT,HCDQZ,HCBQZ,HCDTB,HCDFL,HCDTT) DEALLOCATE (HAGGZ,HAGPZ,HCDXB,HCODL,HCDHH,HTPHH,HCDBS,HCDCT,HCDXP) DEALLOCATE (HCDLT,NOMST,HGMZ,HCDCH,HFINP,HFILN) C::::::::::::::::::::::::::::::::::::::::::::: MAIN: DEALLOCAZIONE I/R/H DEALLOCATE (HDIS,HSTT,HDSP,HFOD,HINIF,HFINF,INDQJ,ISTZ,ISMZ,HCPRZ) DEALLOCATE (NZST,HCDMZ,HCDTS,HSLZ,PHTZ,IHTZ,IPHZ,NPHZ) C::::::::::::::::::::::::::::::::::::::::::::::::::::: TERMINE PROGRAMMA CALL ENDPRG(00) C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE STOP '' END C+++++DSPRED C----------------------------------------------------------------------- SUBROUTINE DSPRED(HFOUT,KO) C----------------------------------------------------------------------- INTEGER (0004) KO,LF,IIIIII CHARACTER( *) HFOUT CHARACTER(0008) HS(00:01) CHARACTER(0056) HSD C....................................................................... HS(00)='IN CORSO';HS(01)='ESEGUITA';LF=LEN_TRIM(HFOUT)-04 WRITE(HSD,'(10HREDAZIONE ,A8,X,<36-LF>(1H.),X,A)')HS(KO),HFOUT IIIIII=10000*KO;CALL HDISPL(IIIIII,HSD) C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++HSTRP C----------------------------------------------------------------------- SUBROUTINE HSTRP(HFS,HFT,NN,HCODE,HHH,IPRG,NX,NZ,IZ,IK) C----------------------------------------------------------------------- USE PARs C----------------------------------------------------------------------- INTEGER (0004) IPRG(00:NX,NZ),NN,NX,IK,IZ,NZ,I1,I2 CHARACTER( *) HCODE(*),HFS,HFT,HHH CHARACTER(0016) HCNTH C....................................................................... IF(NN >00)THEN I1=IK+01;I2=IK+17*NN;IK=I2 IF(IK >MDGS)E=ERRRW('ELFO_DGS',00,'025') WRITE(HFS(I1:I2),'((A16,1H;))') & (HCNTH(HCODE(IPRG(KK,IZ))),KK=01,NN) WRITE(HFT(I1:I2),'((A16,1H;))')(HCNTH(HHH),KK=01,NN) ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++HSTRQ C----------------------------------------------------------------------- SUBROUTINE HSTRQ(HFS,SG,NN,VMAT,MR,MC,IPRG,NX,NZ,IO,IZ,IK) C----------------------------------------------------------------------- INTEGER (0004) IPRG(00:NX,NZ),NN,MR,MC,NX,NZ,IO,IZ,IK,I1,I2 REAL (0004) VMAT(MR,MC),SG(*) CHARACTER( *) HFS CHARACTER(0016) HF04 C....................................................................... IF(NN >00)THEN I1=IK+01;I2=IK+17*NN;IK=I2 WRITE(HFS(I1:I2), '((A16,1H;))') & (HF04(SG(KK)*VMAT(IO,IPRG(KK,IZ))),KK=01,NN) ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++HLMRSP C----------------------------------------------------------------------- SUBROUTINE HLMRSP (HH,IP) C----------------------------------------------------------------------- C HOLLERITH STRING HH POSITIONED (LEFT/MEDIUM/RIGHT) DISPLAY C----------------------------------------------------------------------- C IP 00=LEFT 01=MEDIUM 02=RIGHT C----------------------------------------------------------------------- USE IFWIN INTEGER(8) FHANDLE LOGICAL(8) WSTAT TYPE(T_CONSOLE_SCREEN_BUFFER_INFO) INFOVIDEO TYPE(T_COORD) DIFINE,CURPOS C----------------------------------------------------------------------- INTEGER (0004) IP,KP,IPSZ(00:02) CHARACTER( *) HH C....................................................................... FHANDLE=GETSTDHANDLE(STD_OUTPUT_HANDLE) WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) DIFINE=INFOVIDEO.DWSIZE CURPOS=INFOVIDEO.DWCURSORPOSITION C....................................................................... IRIGH=CURPOS.Y C....................................................................... LARGH=DIFINE.X LH=MAX(01,LEN_TRIM(HH));KP=MIN(MAX(00,IP),02) IPSZ(00)=03;IPSZ(01)=(LARGH+01-LH)/02;IPSZ(02)=LARGH-LH-03 C....................................................................... CURPOS.X=IPSZ(KP) CURPOS.Y=00 WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) WRITE(*,'(A)') HH C....................................................................... CURPOS.X=00 CURPOS.Y=IRIGH WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN RETURN END C+++++CONFIG C----------------------------------------------------------------------- SUBROUTINE CONFIG (NOME) C----------------------------------------------------------------------- C LETTURA DELLE DIRECTORIES DI RESIDENZA DEI FILES INPUT/OUTPUT C----------------------------------------------------------------------- USE NOMD;USE MVAR C----------------------------------------------------------------------- CHARACTER( *) NOME C:::::::::::::::::::::::::: APERTURA /CONTROLLO ESISTENZA CONFIGURAZIONE OPEN (UNIT=01,FILE=NOME,STATUS='OLD',IOSTAT=IERR ) C:::::::::::::::::::::::::::::::::::::::::: ASSETTO SENZA CONFIGURAZIONE QUA='.BIN' DO K=01,30 LCDIR(K)=00 WRITE(HCDIR(K),'(1000(1H ))') ENDDO IF(IERR/=00)RETURN C:::::::::::::::::::::::::::::::::::::::::::: ASSETTO CON CONFIGURAZIONE QUA='.BIN' II=00 IERS=00 DO WHILE (II <30.AND.IERS==00) II=II+01 READ (01,'(T21,A1000)',IOSTAT=IERS) HCDIR(II) IF(IERS==00)THEN LD=LEN_TRIM(HCDIR(II)) IF(LD >00)THEN IF(HCDIR(II)(LD:LD)/='\')LD=LD+01 HCDIR(II)(LD:LD)='\' ENDIF LCDIR(II)=LD ENDIF ENDDO C....................................................................... CLOSE(UNIT=01) C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++OPFILE C----------------------------------------------------------------------- SUBROUTINE OPFILE (ND,NC,HNOMEF,HSTATO,IERR) C----------------------------------------------------------------------- C APERTURA NOMEFILE COMPOSITO DIRECTORY+NOME C----------------------------------------------------------------------- USE NOMD;USE MVAR C----------------------------------------------------------------------- CHARACTER( *) HNOMEF,HSTATO CHARACTER(0001) H CHARACTER(0120) HDSPLY CHARACTER(1500) NOMDEL C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: WRITE(NOMDEL,'(400(1H ))') C....................................................................... LD=LCDIR(ND) LN=LEN_TRIM(HNOMEF) WRITE(NOMDEL,'(A,A)')HCDIR(ND),HNOMEF LU=LD+LN C........................................................... SEQUENZIALE 10 IF (NC >00.AND.NC<=99) THEN OPEN (UNIT=NC,FILE=NOMDEL(01:LU),STATUS=HSTATO,IOSTAT=IERR ) C................................................................ RANDOM ELSEIF(NC >100.AND.NC<=99999.AND.MOD(NC,100)/=00) THEN LR=NC/100 NK=MOD(NC,100) OPEN (UNIT=NK,FILE=NOMDEL(01:LU),STATUS=HSTATO,FORM='UNFORMATTED', & ACCESS='DIRECT',RECL=LR,IOSTAT=IERR ) C................................................................ ERRORE ELSE E=ERRRW('OPFILE',00,'015') ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: IF(HSTATO=='REPLACE'.AND.IERR/=00)THEN IF(KL==01)WRITE(HDSPLY,'(17HATTENZIONE: FILE ,A,9H OCCUPATO)') & HNOMEF IF(KL==02)WRITE(HDSPLY,'(17HATTENTION : FILE ,A,9H OCCUPIED)') & HNOMEF CALL HDISPL(000000,HDSPLY) IF(KL==01)CALL HDISPL (100000,'INVIARE NON APPENA LIBERO & >') IF(KL==02)CALL HDISPL (100000,'SEND AS SOON AS FREED >') READ '(A1)',H CALL SALTO('-1 ') GO TO 10 ENDIF C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++DEFILE C----------------------------------------------------------------------- SUBROUTINE DEFILE (ND,HNOMEF) C----------------------------------------------------------------------- C DISTRUZIONE NOMEFILE COMPOSITO DIRECTORY+NOME C----------------------------------------------------------------------- USE NOMD C----------------------------------------------------------------------- CHARACTER( *) HNOMEF CHARACTER(1500) NOMDEL C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: WRITE(NOMDEL,'(400(1H ))') C....................................................................... LD=LCDIR(ND) LN=LEN_TRIM(HNOMEF) WRITE(NOMDEL,'(6H@DEL ",A,A,1H")')HCDIR(ND),HNOMEF C........................................................... DISTRUZIONE LU=LD+LN+07 CALL SYSTEMQQ(NOMDEL(01:LU)) C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++GECONF C----------------------------------------------------------------------- SUBROUTINE GECONF (HFINP,HFILN) C----------------------------------------------------------------------- C APERTURA LOG /CONTROLLO CONFIGURAZIONE E CSV C----------------------------------------------------------------------- USE PARs;USE NOMD;USE TCPU;USE MVAR C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C--------------------------------------- GECONF: DEFINIZIONE ARGOMENTI H CHARACTER(0040) HFINP(MINP,03),HFILN(MINP,00:25) C------------------------------------------- GECONF: DEFINIZIONI INTERNE CHARACTER(0028) HDGSF(03) CHARACTER(0040) HFILE CHARACTER(0080) HDSPL C----------------------------------------------------------------------- DATA HDGSF/ ': MODULO MANCANTE/OCCUPATO ', & ': MODULE MISSING/OCCUPIED ', & ': '/ C::::::::::::::::::::::::::::::::::::::::::::::::::::::::: APERTURA .RES NFC=12 CALL OPFILE (02,NFC,'ELFO_DGS.RES','REPLACE',IERR) C...................................................... FRONTESPIZIO LOG CALL VLNPAG(00) C::::::::::::::::::::::::::::::::::::::::::::: CATALOGO MODULI INPUT BIN HFINP(01,01)='INFORMAZIONI_GENERALI 067' HFINP(02,01)='SOCIETA_PRODUZIONE 011' HFINP(03,01)='COMBUSTIBILI_TERMICI 014' HFINP(04,01)='GENERAZIONE_TERMICA 040' HFINP(05,01)='COSTI_INCREMENTALI 048' HFINP(06,01)='GENERAZIONE_IDRICA 024' HFINP(07,01)='TRASPORTO_LINEE 096' HFINP(08,01)='ZONE 425' HFINP(09,01)='CALENDARIO 182' HFINP(10,01)='TIPI_GENERAZIONE_EQUIVALENTE 091' HFINP(11,01)='IMPORT_EXPORT 011' HFINP(12,01)='CONTRATTI_TERMICI 221' HFINP(13,01)='PROFILI_EQ_FERMABILI 011' HFINP(14,01)='ELETTROLIZZATORI 014' C.................. ....+....1....+....2....+....3....+....4 ........... HFINP(01,02)='GENERAL_INFORMATION 067' HFINP(02,02)='PRODUCTION_COMPANIES 011' HFINP(03,02)='THERMAL_FUELS 014' HFINP(04,02)='THERMAL_GENERATION 040' HFINP(05,02)='INCREMENTAL_COSTS 048' HFINP(06,02)='HYDRO_GENERATION 024' HFINP(07,02)='INTERCONNECTIONS 096' HFINP(08,02)='ZONES 425' HFINP(09,02)='CALENDAR 182' HFINP(10,02)='EQUIVALENT_GENERATION_TYPES 091' HFINP(11,02)='IMPORT_EXPORT 011' HFINP(12,02)='THERMAL_CONTRACTS 221' HFINP(13,02)='FLEXIBLE_EQ_PROFILES 011' HFINP(14,02)='ELECTROLYSERS 014' C.................. ....+....1....+....2....+....3....+....4 ........... HFINP(01,03)=' 067' HFINP(02,03)=' 011' HFINP(03,03)=' 014' HFINP(04,03)=' 040' HFINP(05,03)=' 048' HFINP(06,03)=' 024' HFINP(07,03)=' 096' HFINP(08,03)=' 425' HFINP(09,03)=' 182' HFINP(10,03)=' 091' HFINP(11,03)=' 011' HFINP(12,03)=' 221' HFINP(13,03)=' 011' HFINP(14,03)=' 014' C::::::::::::::::::::::::::::::::::: CONTROLLO PRESENZA MODULI INPUT BIN LL=LEN_TRIM(HFINP(01,KL)(01:37)) WRITE(HFILE,'(A,A4,<36-LL>(1H ))')HFINP(01,KL),QUA READ (HFINP(01,KL)(38:40),'(I3)')LREC;LREC=LREC*100+11 HFILN(01,00)=HFILE CALL OPFILE (04,LREC,HFILE,'OLD',IERR) C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: FORMA NORMALE O BREVE A CORPO UNICO IF(IERR==00)THEN READ (11,REC=01,IOSTAT=IER) IFUNZIONE IF(IER/=00)E=ERRRW(HFILE(01:LL),02,'026') READ (11,REC=02,IOSTAT=IER) HDSPL,IDATI,IDATF IF(IER/=00)E=ERRRW(HFILE(01:LL),02,'001') CLOSE(UNIT=11) C....................................................................... IK=00 DO II=02,MINP LL=LEN_TRIM(HFINP(II,KL)(01:37)) WRITE(HFILE,'(A,A4,<36-LL>(1H ))')HFINP(II,KL),QUA READ (HFINP(II,KL)(38:40),'(I3)')LREC;LREC=LREC*100+11 HFILN(II,00)=HFILE CALL OPFILE (04,LREC,HFILE,'OLD',JERR) C................................................................. KO/OK IF(JERR/=00)THEN NNNNNN=201000*(01-IK)+200000*IK WRITE(HDSPL,'(A,A28,<52-LL>(1H ))') HFILE,HDGSF(KL) CALL HDISPL(NNNNNN,HDSPL) IK=01 ELSE CLOSE(UNIT=11) ENDIF ENDDO C....................................................................... MESX=00;MESY=00 WRITE(HDATE,'(I8.8,1H-,I8.8)') IDATI,IDATF IF(IK >00)CALL ENDPRG(01) C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: FORMA BREVE A CORPO PARALLELO ELSE JERR=01;II=00 DO WHILE (II <24.AND.JERR/=00) II=II+01 WRITE(HFILE,'(A,1H_,I2.2,A4,<33-LL>(1H ))')HFINP(01,KL),II,QUA CALL OPFILE (04,LREC,HFILE,'OLD',JERR) ENDDO IF(JERR==00)THEN READ (11,REC=01,IOSTAT=IER) IFUNZIONE IF(IER/=00)E=ERRRW(HFILE(01:LL),02,'026') READ (11,REC=02) HDSPL,IDATI,IDATF,(KK,JJ=01,02),MESI,MESF, & (KK,JJ=01,07),KFBW,MESA,MESB,NGA,NGB,NDA,NDB IF (KFBW/=MESA.OR.MESA/=MESB.OR.MESA/=MESI.OR.NGA/=01.OR.NDA/=01) & E=ERRRW(HFILE(01:LL+03),02,'021') CLOSE(UNIT=11) ELSE HFILE(LL+01:LL+03)='_XX';E=ERRRW(HFILE(01:LL+03),02,'022') ENDIF C....................................................................... IK=00 DO II=01,MINP LL=LEN_TRIM(HFINP(II,KL)(01:37)) READ (HFINP(II,KL)(38:40),'(I3)')LREC;LREC=LREC*100+11 DO IM=MESI,MESF WRITE(HFILE,'(A,1H_,I2.2,A4,<33-LL>(1H ))')HFINP(II,KL),IM,QUA HFILN(II,IM)=HFILE CALL OPFILE (04,LREC,HFILE,'OLD',JERR) C................................................................. KO/OK IF(JERR/=00)THEN NNNNNN=201000*(01-IK)+200000*IK WRITE(HDSPL,'(A,A28,<49-LL>(1H ))') HFILE,HDGSF(KL) CALL HDISPL(NNNNNN,HDSPL) IK=01 ELSE IF(II==01)THEN READ (11,REC=02) HDSPL,(KK,JJ=01,13),KFBW IF(KFBW/=IM)E=ERRRW(HFILE(01:LL+03),02,'021') ENDIF CLOSE(UNIT=11) ENDIF ENDDO ENDDO C....................................................................... MESX=MESI;MESY=MESF WRITE(HDATE,'(I8.8,1H-,I8.8)') IDATI,IDATF IF(IK >00)CALL ENDPRG(01) C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: ENDIF C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++IRVID C----------------------------------------------------------------------- SUBROUTINE IRVID(IVID,LVID) C----------------------------------------------------------------------- INTEGER (0004) IVID,LVID C....................................................................... IVID=IVID+01 IF(IVID >LVID)THEN CALL VLNPAG(02);IVID=05 ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++INPBIN C----------------------------------------------------------------------- SUBROUTINE INPBIN ! INPUT MODULI BIN DA ELFO++C C----------------------------------------------------------------------- & (IDATA,HDATA,HCODZ,HCODS,IHPV,HCDQZ,HTECT,HCDCB, & HFILN,HCBQZ,HCDTB,HCDFL,HGMZ,IZQX,IQPZ, & ITITB,POCTB,EMFTB,HCDTT,IZTT,ISCT,IDST,ICCT,HAGGZ, & NGI,NGF,ING,HAGPZ,RIPRZ,SBPQ,BDTT,GQTZ,HCDCH,ICCH, & DCGCT,NSGCT,DCMCT,NSMCT,ITICT,ISTT,CCMB,CLOG,CETS, & CN2T,CN1T,CN0T,ICBT,PCBT,NCTT,DSTT,PXDT,PHTT,PMTT, & PXTT,PRMT,ICTT,CNCB,CNTS,CMCT,CXCT,CMCB,CXCB,CMTS, & CXTS,PMTC,VHCH,PRXTT,PNON,TRHL,PINT,PRXTP,HFINP, & CCCQZ,IZCH,ISCH,IZFL,ISFL,HCODL,HCDHH,CHTZ,HTPHH, & IMCT,IKTT,CTVD,PZST,CAVT,SBPT,SBCH,HCDCT,CLGCT, & CLMCT,PHHH,IHCH,IHFL,ML,TRML,TRXL,RISE,IDTT,ISTA, & IESE,HCDXP,IZXP,PMXP,PHXP,PXXP,PRXP,PHCH,PXCH, & PHFL,PTTX,IZHH,IMAT,PMAT,HCDXB,NOMST,ICBQZ,IPRT, & ADUE,AUNO,AZER,IMZZ,ICCPZ,IDIT,NXTZ,PHQX,CECQZ, & HCDBS,IZBS,ISBS,VHBS,PHBS,SBBS,CT2T,CT1T,CT0T, & MESG,PXBS,LHTR,MES1,MES2,MESI,MESF,HCDLT,IZLT) C----------------------------------------------------------------------- USE PARs;USE IN01;USE MVAR C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C--------------------------------------- INPBIN: DEFINIZIONE ARGOMENTI I INTEGER (0004) IDATA(366),IHPV(MORE),ITITB(MTCL),IZTT(MTTT) INTEGER (0004) ISCT(MTTT),IDST(MTTT),ICCT(MTTT),NGI(00:25) INTEGER (0004) NGF(00:25),ING(MORE),ICCH(MHHS),IZCH(MHHS) INTEGER (0004) ISCH(MHHS),IZFL(MHHF),ISFL(MHHF),IMCT(MORE,MTTT) INTEGER (0004) IKTT(MTTT),NSGCT(24,MTCT),NSMCT(24,MTCT),IMAT(06) INTEGER (0004) ITICT(MTCT),ISTT(MORE,MTTT),ICBT(MORE,MTTT,02) INTEGER (0004) NCTT(MORE,MTTT),ICTT(MORE,MTTT),IZXP(MEMX) INTEGER (0004) IHCH(MHHS),IHFL(MHHF),ML(MLLL,05),IDTT(MORE,MTTT) INTEGER (0004) ISTA(MORE,MTTT),IESE(MORE,MTTT),NXTZ(MORE,MZZZ) INTEGER (0004) IZHH(MHHH),ICBQZ(MEQT),IPRT(MTTT),IDIT(MTTT) INTEGER (0004) IMZZ(MORE,MZZZ),ICCPZ(MZZZ),IZBS(MBES),ISBS(MBES) INTEGER (0004) IZLT(MZZZ),MESG(MGGG),MES1,MES2,MESI,MESF INTEGER (0004) IZQX(MEQT),IQPZ(MZZZ,MEQT) C--------------------------------------- INPBIN: DEFINIZIONE ARGOMENTI R REAL (0004) POCTB(MTCL),EMFTB(MTCL,04),RIPRZ(MZZZ),CCCQZ(MEQT) REAL (0004) SBPQ(MORE,MZZZ),BDTT(MORE,MTTT),CTVD(MGGG) REAL (0004) CAVT(MORE,MTTT),SBPT(MORE,MTTT),SBCH(MORE,MHHS) REAL (0004) CLGCT(24,MTCT,00:05),CLMCT(24,MTCT,00:05) REAL (0004) DCGCT(24,MTCT,00:05),DCMCT(24,MTCT,00:05) REAL (0004) CCMB(MORE,MTTT,02),CETS(MORE,MTTT,02) REAL (0004) CN2T(MORE,MTTT,02),CN1T(MORE,MTTT,02) REAL (0004) CN0T(MORE,MTTT,02),CT2T(MORE,MTTT,02) REAL (0004) DSTT(MORE,MTTT),PXDT(MORE,MTTT),PHTT(MORE,MTTT) REAL (0004) PMTT(MORE,MTTT),PXTT(MORE,MTTT),PRMT(MORE,MTTT) REAL (0004) CNCB(MORE,MTTT),CNTS(MORE,MTTT),CMCT(MORE,MTTT) REAL (0004) CXCT(MORE,MTTT),CMCB(MORE,MTTT),CXCB(MORE,MTTT) REAL (0004) CMTS(MORE,MTTT),CXTS(MORE,MTTT),PMXP(MORE,MEMX) REAL (0004) PHXP(MORE,MEMX),PXXP(MORE,MEMX),PRXP(MORE,MEMX) REAL (0004) PHCH(MORE,MHHS,03),PXCH(MORE,MHHS),PHFL(MORE,MHHF) REAL (0004) PHHH(MORE,MHHH,03),TRML(MORE,MLLL),TRXL(MORE,MLLL) REAL (0004) RISE(MORE,MQZZ,07),PTTX(MTTT),ADUE(MORE,MTTT) REAL (0004) VHCH(00:MORE,MHHS),PRXTT(MORE,00:MZZZ) REAL (0004) TRHL(MORE,MLLL),PZST(MGGG),LHTR(MORE,MLLL) REAL (0004) PRXTP(MORE,00:MZZZ),PHQX(MORE,MEQT),CECQZ(MEQT) REAL (0004) PMAT(MORE,MZZZ,04),CLOG(MORE,MTTT,02) REAL (0004) AUNO(MORE,MTTT),AZER(MORE,MTTT),CT0T(MORE,MTTT,02) REAL (0004) VHBS(00:MORE,MBES),PHBS(MORE,MBES,03) REAL (0004) PCBT(MORE,MTTT,02),SBBS(MORE,MBES),PXBS(MORE,MBES) REAL (0004) CHTZ(MORE,MQZZ),GQTZ(MORE,MEQT,02,MQZZ) REAL (0004) CT1T(MORE,MTTT,02) C....................................................................... REAL (0008) PINT(00:MORE,MQZZ),PMTC(00:MORE,MQZZ) REAL (0008) PNON(00:MORE,MQZZ) C--------------------------------------- INPBIN: DEFINIZIONE ARGOMENTI H CHARACTER(0012) HDATA(366) CHARACTER(0016) HCODZ(00:MQZZ),HCODS(MQPD),HCDQZ(MEQT),HTECT(MTTT) CHARACTER(0016) HCDCB(00:MTCL),HCDTT(MTTT),HAGGZ(MQZZ),HAGPZ(MZZZ) CHARACTER(0016) HCDCH(MHHS),HCODL(MLLL),HCDHH(MHHH),HTPHH(MHHH) CHARACTER(0016) HCDCT(MTCT),HCDXP(MEMX),HCBQZ(MEQT),HCDXB(MTCL) CHARACTER(0016) NOMST(MZZZ),HCDTB(MTCL),HGMZ(MORE,MZZZ) CHARACTER(0016) HCDBS(MBES),HCDLT(MZZZ),HCDFL(MHHF) CHARACTER(0040) HFINP(MINP,03),HFILN(MINP,00:25) C------------------------------------------- INPBIN: DEFINIZIONI INTERNE INTEGER (0004) NDI(00:25),NDF(00:25) REAL (0004) E,ERRRW,LMBD REAL (0008) PDUE CHARACTER(0012) HDATH CHARACTER(0016) HCODX,HCODY,NOMPR,HCODJ,HCODW CHARACTER(0040) HTITY CHARACTER(0080) HDSPL C------------------------------------------ INPBIN: ALLOCABILI INTERNI I INTEGER (0004),ALLOCATABLE :: LNINP(:),INDTB(:),IFTT(:),NGMS(:) INTEGER (0004),ALLOCATABLE :: IGSET(:),ITGT(:),MESEG(:) C------------------------------------------ INPBIN: ALLOCABILI INTERNI R REAL (0004),ALLOCATABLE :: F15(:),VMCH(:,:),VXCH(:,:),BDFX(:) REAL (0004),ALLOCATABLE :: CMHCT(:,:),CXHCT(:,:),CMGCT(:,:) REAL (0004),ALLOCATABLE :: CXGCT(:,:),CMMCT(:,:),CXMCT(:,:) REAL (0004),ALLOCATABLE :: CNCT(:,:),PMDT(:,:),PMCH(:,:) REAL (0004),ALLOCATABLE :: VHFL(:,:),ANCH(:,:),LAMBZ(:,:) REAL (0004),ALLOCATABLE :: AMCH(:,:),SHCH(:,:),LVCH(:,:,:) REAL (0004),ALLOCATABLE :: CSSZ(:,:,:,:),RHCH(:,:),PTCO2(:,:) C------------------------------------------ INPBIN: ALLOCABILI INTERNI H CHARACTER(0016),ALLOCATABLE :: HCBT(:),HHHHH(:,:),NOFL(:),NOCH(:) CHARACTER(0016),ALLOCATABLE :: HVLCH(:),HCDQX(:) CHARACTER(0080),ALLOCATABLE :: HINIZ(:),HFINE(:),HINIF(:),HFINF(:) C::::::::::::::::::::::::::::::::::::::::::: INPBIN: ALLOCAZIONE INTERNI ALLOCATE (LNINP(MINP),HCBT(02),HHHHH(04,03),NGMS(00:25)) ALLOCATE (HINIZ(MINP),HFINE(MINP),HINIF(03),HFINF(03)) ALLOCATE (INDTB(00:MTCL),IFTT(MTTT),F15(21+02*MEQT)) ALLOCATE (HVLCH(MHHS),NOFL(MHHF),NOCH(MHHS),HCDQX(MEQT)) ALLOCATE (VMCH(00:MORE,MHHS),VXCH(00:MORE,MHHS),CMHCT(24,MTCT)) ALLOCATE (CXHCT(24,MTCT),CMGCT(24,MTCT),CXGCT(24,MTCT)) ALLOCATE (CMMCT(24,MTCT),CXMCT(24,MTCT),IGSET(MGGG),ITGT(MTTT)) ALLOCATE (MESEG(MGGG),CNCT(MORE,MTTT),PMDT(MORE,MTTT)) ALLOCATE (PMCH(MORE,MHHS),VHFL(MORE,MHHF)) ALLOCATE (ANCH(MORE,MHHS),AMCH(MORE,MHHS)) ALLOCATE (SHCH(MORE,MHHS),LVCH(MORE,MHHS,03),PTCO2(MGGG,MZZZ)) ALLOCATE (CSSZ(MORE,MZZZ,00:MSPD,02),RHCH(MORE,MHHS)) ALLOCATE (LAMBZ(MORE,MZZZ),BDFX(MORE)) C....................................................................... CALL VLNPAG(02) C....................................................................... HHHHH(01,01)='SERBATOIO ' HHHHH(02,01)='POMPAGGIO ' HHHHH(03,01)='BATTERIA ' HHHHH(04,01)='FLUENTE ' HHHHH(01,02)='RESERVOIR ' HHHHH(02,02)='PUMPED-STORAGE ' HHHHH(03,02)='BATTERY ' HHHHH(04,02)='RUN-OF-RIVER ' HHHHH(01,03)=' ' HHHHH(02,03)=' ' HHHHH(03,03)=' ' HHHHH(04,03)=' ' C:::::::::::::::::::::::::::::::::::::::::::::::::::: NOMENCLATURA INPUT WRITE(HINIF(01),'(''LETTURA IN CORSO '', 63(1H.))') WRITE(HINIF(02),'(''READING IN PROGRESS '', 60(1H.))') WRITE(HINIF(03),'('' '', 63(1H.))') WRITE(HFINF(01),'(''LETTURA ESEGUITA '', 63(1H.))') WRITE(HFINF(02),'(''READING COMPLETED '', 62(1H.))') WRITE(HFINF(03),'('' '', 63(1H.))') C....................................................................... DO II=01,MINP READ (HFINP(II,KL)(38:40),'(I3)') LNINP(II) LNINP(II)=100*LNINP(II)+15 LL=LEN_TRIM(HFINP(II,KL)(01:37)) HDSPL=HINIF(KL) HDSPL(54-LL:54-LL)=' ' HDSPL(55-LL:58)=HFINP(II,KL)(01:LL) HINIZ(II)=HDSPL(01:58) HDSPL=HFINF(KL) HDSPL(54-LL:54-LL)=' ' HDSPL(55-LL:58)=HFINP(II,KL)(01:LL) HFINE(II)=HDSPL(01:58) ENDDO C======================================================================= C INFORMAZIONI GENERALI C=================================================================== 001 CALL HDISPL(001000,HINIZ(001)(01:58)) DO IM=MESX,MESY CALL OPFILE(04,LNINP(001),HFILN(001,IM),'OLD',IERR ) READ (15,REC=01,IOSTAT=IER) II,HTITX IF(IER/=00)E=ERRRW(HFILN(001,IM),01,'001') READ (15,REC=02,IOSTAT=IER) ICASO,HTITO,IDATI,IDATF,NZ,MES1,MES2, & MESI,MESF,IFOD,ISTW,ILSW,IDSW,IMSW,IPRW,IQGW,KFBW,MESA,MESB, & NGI(IM),NGF(IM),NDI(IM),NDF(IM),NGMS(MESI:MESF) IF(IER/=00)E=ERRRW(HFILN(001,IM),02,'001') CLOSE(UNIT=15) ENDDO CALL HDISPL(010000,HFINE(001)(01:58)) C======================================================================= IG=00 DO IM=MESI,MESF NGI(IM)=IG+01 IG=IG+NGMS(IM) NGF(IM)=IG MESG(NGI(IM):NGF(IM))=IM ENDDO NG=NDF(MESY)/24 C======================================================================= C CALENDARIO E DETTAGLIO FASCE ORARIE C=================================================================== 009 CALL HDISPL(000000,HINIZ(009)(01:58)) DO IM=MESX,MESY CALL OPFILE(04,LNINP(009),HFILN(009,IM),'OLD',IERR ) IREC=01 READ (15,REC=IREC,IOSTAT=IER) NX,HTITY IF(IER/=00)E=ERRRW(HFILN(009,IM),01,'001') C IF(HTITY/=HTITX)E=ERRRW(HFILN(009,IM),00,'002') NG1=NGI(IM);NG2=NGF(IM) C....................................................................... DO IG=NG1,NG2 IB=24*IG IA=IB-23 IREC=IREC+01 READ (15,REC=IREC,IOSTAT=IER) IDATA(IG),IGSET(IG),MESEG(IG), & IHPV(IA:IB),PRXTT(IA:IB,00),PRXTP(IA:IB,00),BDFX(IA:IB),CTVD(IG), & PTCO2(IG,01:NZ),CMCO2,PZST(IG) IF(IER/=00)E=ERRRW(HFILN(009,IM),IREC,'001') HDATA(IG)=HDATH(IDATA(IG),IFOD) ENDDO C....................................................................... CLOSE(UNIT=15) ENDDO CALL HDISPL(010000,HFINE(009)(01:58)) C======================================================================= NO=24*NG DO IO=01,NO ING(IO)=(IO-01)/24+01 ENDDO C....................................................................... IF(KL==01)HCDQZ(01)='GENERAZ.EQUIVAL.' IF(KL==02)HCDQZ(01)='EQUIVAL.GENERAT.' C======================================================================= C TIPI GENERAZIONE EQUIVALENTE C=================================================================== 010 CALL HDISPL(000000,HINIZ(010)(01:58)) DO IM=MESX,MESX CALL OPFILE(04,LNINP(010),HFILN(010,IM),'OLD',IERR ) IREC=01 READ (15,REC=IREC,IOSTAT=IER) NQZ,HTITY IF(IER/=00)E=ERRRW(HFILN(010,IM),01,'001') C IF(HTITY/=HTITX)E=ERRRW(HFILN(010,IM),00,'002') IF(NQZ >MEQT) E=ERRRW(HFILN(010,IM),00,'016') C....................................................................... IQZ=00 DO WHILE (IQZ 00)THEN PC=FLOAT(IEXTR(MMXT,04,04))/1000.000 IJ=00 DO WHILE (IJ 00)THEN Cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx C ITX=JZERO((PG-PM)*(PG-PX),0.010) C ITY=JZERO( PG-PX ,0.100) C IDTT(IO,ITT)=02*(01-ITX)+ITX*(02*ITY+01) LMBD=LAMBZ(IO,IZTT(ITT))-LMBD IF (ABS(LMBD) <1.00E-03)THEN;IDTT(IO,ITT)=02 ELSEIF( LMBD <0.00E+00)THEN;IDTT(IO,ITT)=01 ELSEIF( LMBD >0.00E+00)THEN;IDTT(IO,ITT)=03 ENDIF Cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx IJ=00 DO WHILE (IJ )',IOSTAT=IERR) HFOX IF(IERR/=00.AND.IR==01)RETURN IF(IERR==00.AND.HFOX(1:1)/='*')THEN LL=LEN_TRIM(HFOX)-01;IERR=02;IF(LL <00)GO TO 500 NCC=01;IC=00 DO WHILE (IC 00)THEN C........................................... RILEVAZIONE DEL PASSO (KPF) KPF=00;IPF=00;IER=00 DO WHILE (IPF <05.AND.IER==00) IPF=IPF+01 READ (HSTF(001:IPF),'(I)',IOSTAT=IER) JPF IF(IER/=00)KPF=IPF ENDDO IERR=10;IF(KPF <02.OR.MOD(LSTF,KPF)/=00)GO TO 500 C............................. CALCOLO NUMERO E TIPO DEI CAMPI (MCF,ITF) MCF=00 DO K=KPF,LSTF,KPF H=HSTF(K:K) I=00 DO J=01,10 IF(H==HSH(J:J))I=J ENDDO IERR=03 IF(I==00)GO TO 500 READ (HSTF(K-KPF+01:K-01),'(I)',IOSTAT=IER) NCF IERR=04 IF(IER/=00)GO TO 500 IERR=05 IF(MCF+NCF >MCL)GO TO 500 DO J=MCF+01,MCF+NCF ITF(J)=I ENDDO MCF=MCF+NCF ENDDO C............................................. REGISTRAZIONE (HSTP,LSTP) HSTP(0001:LSTF)=HSTF(0001:LSTF) LSTP=LSTF C....................................................................... ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: II=00 HFOX(01:01)='*' DO WHILE (II <100.AND.HFOX(01:01)=='*') II=II+01 IR=IR+01 READ (NHF,'(A)') HFOX C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: RIGA ATTIVA IF(HFOX(01:01)/='*')THEN C.............................................. PRE-CONTEGGIO SEPARATORI LL=LEN_TRIM(HFOX) IS=00 DO JJ=01,LL IF(IKS(ICHAR(HFOX(JJ:JJ))) >00)THEN IS=IS+01 ICS(IS)=JJ ENDIF ENDDO C.................................. EVENTUALE AGGIUNTA ULTIMO SEPARATORE IERR=06 IF(IKS(ICHAR(HFOX(LL:LL)))==00.AND.ILS==00)GO TO 500 IF(IKS(ICHAR(HFOX(LL:LL)))==00)THEN IS=IS+01 LL=LL+01 HFOX(LL:LL)=CHAR(059) ICS(IS)=LL ENDIF C.......................................... AGGIUNTA SEPARATORI MANCANTI IA=00 IERR=07 IF(IS =00)THEN JD=IC JS=IP LCL(IS)=LEN_TRIM(HFOX(JS:JD)) DO IJ=IP,IC JJ=IC-IJ+IP IF(HFOX(IJ:IJ)/=' ')JD=IJ IF(HFOX(JJ:JJ)/=' ')JS=JJ ENDDO IF(IT >05)JS=IP KS=KS+JS-IP IF(KS >00)THEN IJ=LF(KS) KK=KK+IJ+02 WRITE(FOXL(KK-IJ-01:KK),'(I,2HX,)')KS ENDIF KK=KK+01 FOXL(KK:KK)=HSH(JT:JT) IJ=LF(JD-JS+01) KK=KK+IJ WRITE(FOXL(KK-IJ+01:KK),'(I)')JD-JS+01 KS=IC-JD+01 C........................................................... CAMPO NULLO ELSE HFOX(IP:IP)=' ' LCL(IS)=00 IF(KS >00)THEN IJ=LF(KS) KK=KK+IJ+02 WRITE(FOXL(KK-IJ-01:KK),'(I,2HX,)')KS ENDIF KK=KK+02 WRITE(FOXL(KK-01:KK),'(A1,1H1)')HSH(JT:JT) KS=00 ENDIF IF(JT >03)THEN KK=KK+02 FOXL(KK-01:KK)='.0' ENDIF C........................................................ CHIUSURA CAMPO KK=KK+01 FOXL(KK:KK)=',' IP=IC+02 C:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:. ENDDO C:..:..:..:..:..:..:..:..:..:..:..:..: FINC CAMPO / CHIUSURA DEL FORMATO FOXL(KK:KK)=')' FOXF=FOXL(01:KK) IRIGA=IRIGA+01 INFOR=IRIGA C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: RIGA COMMENTO ELSE IERR=09 IF(II >99)GO TO 500 ENDIF C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: ENDDO C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ENDIF C======================================================================= C FINE C======================================================================= RETURN C=========================================================== DIAGNOSTICA 500 IF (KL==01)THEN WRITE(HERRN,'(''ELFO_DGS: INFOR: LETTURA MODULO '',A29,'' ERRORE'' &,I4.3)') NOHF,IERR C....................................................................... IF(IERR == 01)WRITE(HERRD,'(''MANCANZA DI CAMPI DI LETTURA ENTRO I & PRIMI 008 RECORD'')') IF(IERR == 02)WRITE(HERRD,'(''RIGA '',I5.3,'': BIANCA'')') IR IF(IERR == 03)WRITE(HERRD,'(''TIPO DI FORMATO '',A1,'' NON RICONOS &CIUTO'')') HFOX(K:K) IF(IERR == 04)WRITE(HERRD,'( ''ERRORE IN LETTURA LUNGHEZZA TIPO DI & FORMATO '',A1)') HFOX(K:K) IF(IERR == 05)WRITE(HERRD,'(''SUPERATO NUMERO MAX DI '',I6.3,'' CA &MPI DI FORMATO LETTURA'')') MCL IF(IERR == 06)WRITE(HERRD,'(''RIGA '',I5.3,'': ULTIMO CARATTERE NO &N SEPARATORE'')') IR IF(IERR == 07)WRITE(HERRD,'(''RIGA '',I5.3,2H: ,I4.4,'' SEPARATORI & MANCANTI'')') IR,MCF-IS IF(IERR == 08)WRITE(HERRD,'(''RIGA '',I5.3,'': CAMPO '',I3.3,'' CO &N PIU" DI 98 BLANK PRIMA DEL SEPARATORE'')') IR,IS IF(IERR == 09)WRITE(HERRD,'( ''RIGA '',I5.3,'': BLOCCO CON PIU" DI & 99 SCHEDE COMMENTO CONSECUTIVE'')') II IF(IERR == 10)WRITE(HERRD,'(''LA LUNGHEZZA NETTA '',I3.3,'' DELL"A &RGOMENTO DI CHIAMATA '',A,'' DEVE ESSERE UGUALE A 31 O MULTI &PLA DI 02-03-04-05'')') LSTF,HSTF C....................................................................... ELSEIF(KL==02)THEN WRITE(HERRN,'(''ELFO_DGS: INFOR: READING MODULE '',A29,'' ERROR '' &,I4.3)') NOHF,IERR C....................................................................... IF(IERR == 01)WRITE(HERRD,'(''LACK WITHIN THE FIRST 008 RECORDS OF & ANY READABLE FIELD'')') IF(IERR == 02)WRITE(HERRD,'(''ROW '',I5.3,'': BLANK'')') IR IF(IERR == 03)WRITE(HERRD,'(''FORMAT TYPE '',A1,'' NOT RECOGNIZED' &')') HFOX(K:K) IF(IERR == 04)WRITE(HERRD,'(''ERROR READING '',A1,'' FORMAT TYPE L &ENGTH '')') HFOX(K:K) IF(IERR == 05)WRITE(HERRD,'(''NUMBER EXCEEDED OF '',I6.3,'' READIN &G FORMAT FIELDS'')') MCL IF(IERR == 06)WRITE(HERRD,'(''ROW '',I5.3,'': THE LAST CHARACTER I &S NOT A SEPARATOR'')') IR IF(IERR == 07)WRITE(HERRD,'(''ROW '',I5.3,2H: ,I4.4,'' MISSING SEP &ARATORS'')') IR,MCF-IS IF(IERR == 08)WRITE(HERRD,'(''ROW '',I5.3,'': FIELD '',I4.4,'' WIT &H MORE THAN 98 BLANKS BEFORE THE SEPARATOR'')') IR,IS IF(IERR == 09)WRITE(HERRD,'(''ROW '',I5.3,'': BLOCK WITH MORE THAN & 99 CONSECUTIVE COMMENT CARDS'')') II IF(IERR == 10)WRITE(HERRD, '(''THE NET CALLING ARGUMENT '',A &,'' LENGTH '',I3.3,'' MUST BE EQUAL TO 31 OR A MULTIPLE OF 02-03-0 &4-05'')') HSTF,LSTF ENDIF C....................................................................... E=ERRRW(HERRN,00,HERRD) C....................................................................... END C+++++LF C----------------------------------------------------------------------- FUNCTION LF(MM) C----------------------------------------------------------------------- NN=MM/10 LF=01 DO WHILE (NN >00) LF=LF+01 NN=NN/10 ENDDO C....................................................................... RETURN END C+++++HCNTH C----------------------------------------------------------------------- FUNCTION HCNTH(HHHHH) C----------------------------------------------------------------------- CHARACTER(0016) HCNTH CHARACTER( *) HHHHH INTEGER (0004) LH,LX C....................................................................... LH=MIN(LEN_TRIM(HHHHH),16) LX=(16-LH)/02+MOD(16-LH,02) WRITE(HCNTH,'(X,A,<16-LH-LX>X)') HHHHH C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++IRIGH C----------------------------------------------------------------------- FUNCTION IRIGH(IX) C----------------------------------------------------------------------- C IRIGH = NUMERO DI RIGHE DEL FILECODE IX C----------------------------------------------------------------------- INTEGER (0004) IRIGH CHARACTER(0001) HX C....................................................................... REWIND IX IERR=00 IRIGH=00 DO WHILE (IERR==00) READ (IX,'(A1)',IOSTAT=IERR) HX IF(IERR==00)IRIGH=IRIGH+01 ENDDO REWIND IX C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN RETURN END C+++++HFORM C----------------------------------------------------------------------- FUNCTION HFORM(HF,N1,N2) C----------------------------------------------------------------------- C GENERAZIONE DEL FORMATO PARAMETRICO C----------------------------------------------------------------------- CHARACTER(0008) HFNUM CHARACTER(0400) HFORM CHARACTER( *) HF C....................................................................... LL=LEN(HF) HFNUM='(I . ) ' HFORM=HF(01:LL) C....................................................................... IP=00 DO II=02,LL IJ=II-01 IF (HF(IJ:IJ)/='x'.AND.HF(II:II)=='x')THEN IP=IP+01 I1=II ELSEIF(HF(IJ:IJ)=='x'.AND.HF(II:II)/='x')THEN LM=IJ-I1+01 WRITE(HFNUM(03:03),'(I1)') LM WRITE(HFNUM(05:05),'(I1)') LM IF(IP==01)WRITE(HFORM(I1:IJ),HFNUM) N1 IF(IP==02)WRITE(HFORM(I1:IJ),HFNUM) N2 ENDIF ENDDO C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++CALEND C----------------------------------------------------------------------- SUBROUTINE CALEND (IDATI,NGM,IDATA) C----------------------------------------------------------------------- C CALCOLO DEL CALENDARIO GREGORIANO PER LUNGHEZZA MAX DI 10 ANNI C-------------------------------------------------------------------- in C IDATI = DATA INIZIALE (AAAAMMGG) C NGM = 00 CALENDARIO DELLA SOLA IDATI C > 00 CALENDARIO DI IDATI + NGM GIORNI SEGUENTI C < 00 CALENDARIO DI IDATI - NGM GIORNI PRECEDENTI C------------------------------------------------------------------- out C IDATA = VETTORE CALENDARIO RICHIESTO DI TOT N =IABS(NGM)+01 C GIORNI CON 6 ELEMENTI/GIORNO CONTENENTI (n=giorno): C IDATA(6n-5) = DATA IN FORMA AAAAMMGG C IDATA(6n-4) = NUMERO GIORNO DELLA SETTIMANA (1=LUN .... 7=DOM) C IDATA(6n-3) = NUMERO GIORNO DEL MESE (01:31) C IDATA(6n-2) = NUMERO MESE (01:12) C IDATA(6n-1) = NUMERO ANNO (aaaa) C IDATA(6n ) = NUMERO PROGRESSIVO DELLA FESTIVITA` C 00=nessuna 01=CAPODANNO 02=EPIFANIA C 03=PASQUA 04=ANGELO 05=LIBERAZIONE C 06=LAVORO 07=REPUBBLICA 08=FERRAGOSTO C 09=OGNISSANTI 10=IMMACOLATA 11=NATALE C 12=S.STEFANO C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C----------------------------------------------------------------------- PARAMETER(MGFS=0012) ! numero giorni festivi/anno C--------------------------------------------------- DEFINIZIONI INTERNE INTEGER (0004) IDATA(*),I400(04),I028(07),I004(04) INTEGER (0004) IMNB(12),IMBS(12),NGIO(12),IGFE(MGFS) C----------------------------------------------------------------- SHIFT DATA I400/00,05,03,01/ ! secolari di quadricentenario DATA I028/00,05,03,01,06,04,02/ ! quadriennali in 28 anni DATA I004/00,01,02,03/ ! annuali di quadriennio DATA IMNB/00,03,03,06,01,04,06,02,05,00,03,05/ ! mensili normali DATA IMBS/00,03,04,00,02,05,00,03,06,01,04,06/ ! mensili bisestili C--------------------------------------------------- GIORNI DI OGNI MESE DATA NGIO/31,28,31,30,31,30,31,31,30,31,30,31/ C-------------------------------------------------------- GIORNI FESTIVI DATA IGFE/ 0101,0106,0000,0000,0425,0501,0602,0815,1101,1208,1225, & 1226/ C........................................... SCOMPOSIZIONE DATA INIZIALE IF(IDATI==00)RETURN IA=IDATI/10000 IM=MOD(IDATI,10000)/100 IG=MOD(IDATI,100) C....................................................................... IF(INTIN(0001,IA,9999)==00)E=ERRRW('CALEND',00,'008') IF(INTIN(0001,IM,0012)==00)E=ERRRW('CALEND',00,'009') C::::::::::::::::::::: CALCOLO GIORNO SETTIMANA (01:07) DI DATA INIZIALE I1= (IA-01)/100 +01 ! secolo di giacenza I2=MOD((I1-01),004)+01 ! posizione secolo in quadricentenario I3= (IA-(100*(I1-01)+01))/004 +01 ! quadriennio di giacenza I4=MOD((I3-01),007)+01 ! posizione quadriennio in 28 anni I5=MOD((IA-01),004)+01 ! posizione anno in quadriennio I6=INTIN(00,MOD(IA,100),00) ! divisibilita' anno x 100 I7=INTIN(00,MOD(IA,400),00) ! divisibilita' anno x 400 I8=INTIN(04,I5,04)*(01-I6)+I7 ! anno bisestile I9=IMNB(IM)*(01-I8)+IMBS(IM)*I8 ! shift mensile C....................................................................... NGIO(02)=28+I8 MG=NGIO(IM) IF(INTIN(01,IG,MG)==00)E=ERRRW('CALEND',00,'010') C....................................................................... NGS=MOD((I400(I2)+I028(I4)+I004(I5)+I9+IG-01),07)+01 C:::::::::::::::::::::::::::::::::::::::::::::::::::::: CALCOLO DI IDATA NGMX=IABS(NGM)+01 IS=01 IF(NGM <00)IS=-1 NGMX=MIN(NGMX,3653) NGC=NGS-IS MM1=IM MG1=IG IAC=IA-IS C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: INIZIO CICLO ANNO NGI=00 DO WHILE (NGI 00))KG=KG-07 IF(KG<=31)IPAS=0300+KG IF(KG >31)IPAS=0400+KG-31 IGFE(03)=IPAS C......................................................... LUNEDI ANGELO KG=KG+01 IF(KG<=31)ILUN=0300+KG IF(KG >31)ILUN=0400+KG-31 IF(ILUN==0431)ILUN=0501 IGFE(04)=ILUN C............................................................. BISESTILE I5=INTIN(00,MOD(IAC,004),00) I6=INTIN(00,MOD(IAC,100),00) I7=INTIN(00,MOD(IAC,400),00) I8=I5*(01-I6)+I7 NGIO(02)=28+I8 C....................................................................... IF(MM1==00)MM1=(01+IS)/02+12*((01-IS)/02) MMF=12*((01+IS)/02)+(01-IS)/02 C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: INIZIO CICLO MESE IMC=MM1-IS DO WHILE(IMC*IS 07)NGC=01 IF(NGC <01)NGC=07 C............................................. RICERCA EVENTUALE FESTIVO IDAT=IMC*100+IGC IGF=IDNUM(IGFE,MGFS,01,IDAT) IF(IGF==04.AND.NGC/=01)E=ERRRW('CALEND',00,'011') C.................................................... REGISTRAZIONE DATA IDATA(06*NGI-05)=IAC*10000+IMC*100+IGC IDATA(06*NGI-04)=NGC IDATA(06*NGI-03)=IGC IDATA(06*NGI-02)=IMC IDATA(06*NGI-01)=IAC IDATA(06*NGI )=IGF C....................................................................... ENDDO C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: FINE CICLO GIORNO MG1=00 ENDDO C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: FINE CICLO MESE MM1=00 ENDDO C:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.: FINE CICLO ANNO RETURN END C+++++HDATH C----------------------------------------------------------------------- FUNCTION HDATH (IDATI,IO) C----------------------------------------------------------------------- C IDATI = DATA NUMERICA aaaammgg C IO = 01 HDATH aaaammgg C = 02 HDATH aaaa/mm/gg C = 03 HDATH gg/mm/aa C = 04 HDATH gg/mm/aaaa C----------------------------------------------------------------------- CHARACTER(0012) HDATH C....................................................................... IF(IO >01)THEN IA=IDATI/10000 IM=MOD(IDATI,10000)/100 IG=MOD(IDATI,100) ENDIF IF(IO==01)WRITE(HDATH,'(I8.8)') IDATI IF(IO==02)WRITE(HDATH,'(I4.4,2(1H/,I2.2))') IA,IM,IG IF(IO==03)WRITE(HDATH,'(2(I2.2,1H/),I2.2)') IG,IM,MOD(IA,100) IF(IO==04)WRITE(HDATH,'(2(I2.2,1H/),I4.4)') IG,IM,IA C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++IDNUM C----------------------------------------------------------------------- FUNCTION IDNUM (IDATA,ND,NP,IDATX) C----------------------------------------------------------------------- C IDNUM = Posizione IDATX su ND elementi di IDATA con passo NP C----------------------------------------------------------------------- INTEGER (0004) IDNUM,IDATA(*),ND,NP,IDATX C....................................................................... II=00 IJ=01-NP IDNUM=00 DO WHILE (II 3 NESSUN CENTRAGGIO: INIZIO IN COLONNA u+1 C v = 0:7 TRACCIA DEL CONTORNO C 0 NESSUNO / 1 INIZIO / 2 CONTINUAZIONE / C 3 FINE / 4 MONORIGA DI INIZIO E FINE / C 5 SOTTOLINEA / 6 SOPRALINEA / C 7 SOPRA E SOTTOLINEA C----------------------------------------------------------------------- USE IFWIN;USE MVAR INTEGER(8) FHANDLE LOGICAL(8) WSTAT TYPE(T_CONSOLE_SCREEN_BUFFER_INFO) INFOVIDEO TYPE(T_COORD) DIFINE,CURPOS C----------------------------------------------------------------------- INTEGER (0004) INC(06) C----------------------------------------------------------------------- CHARACTER( *) SH CHARACTER(0008) HN CHARACTER(0240) ST C----------------------------------------------------------------------- DATA INC/218,191,217,192,196,179/ C::::::::::::::::::::::::::::::::::::::::::::::::::: DECODIFICA NUMERICA WRITE(HN,'(I6.6)')IN READ (HN,'(6I1)' )IQ,IS,J,L,M,N C::::::::::::::::::::::::::::::::::::::::::::::::::::::::: IMPAGINAZIONE FHANDLE=GETSTDHANDLE(STD_OUTPUT_HANDLE) WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) DIFINE=INFOVIDEO.DWSIZE LARGH=DIFINE.X C....................................................................... IF(IS >00.AND.IS <09)THEN DO IV=01,02 IF(IV==02)WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) CURPOS=INFOVIDEO.DWCURSORPOSITION IRIGH=CURPOS.Y CURPOS.X=00 CURPOS.Y=IRIGH-IS WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) IL=00 DO WHILE (IL (1H ))') ENDDO ENDDO ELSEIF(IS==09)THEN CALL SYSTEMQQ('@CLS') ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::: LUNGHEZZE STRINGA LA=LEN(SH) WRITE(ST,'(240(1H ))') ST(01:LA)=SH LE=LEN_TRIM(ST) DO IL=01,LE IF(ST(IL:IL)==CHAR(34))ST(IL:IL)=CHAR(39) ENDDO C...................................................... BLANK A SINISTRA KS=00 DO WHILE (KS 03)THEN L1=01 L2=LE+KS ENDIF C:::::::::::::::::::::::::::::::::::::::::::::: POSIZIONAMENTO E DISPLAY LS=L2-L1+01 LC=(LARGH-LS)/02+01 IF(M >03)LC=M+01 C................................................. SALTI RIGA PRECEDENTI K=00 DO WHILE (K 01)WRITE(NOU,'('' '')') ENDDO C................................................ COLLIMATORE DI PARITA' IX=MOD(LARGH-LS-04,02) C..................................................... DISPLAY CODICE 00 IF (N==00)THEN IF (IQ==00)THEN WRITE(* ,'(T,A)') ST(L1:L2) ELSEIF(IQ==01)THEN L2=MIN(L2,LE) LS=L2-L1+01 WRITE(* ,'(T,A,$)') ST(L1:L2) READ (* ,'(A1)') TS ELSEIF(IQ==02)THEN WRITE(* ,'(T,A)') ST(L1:L2) WRITE(NOU,'(4X,A)') ST(L1:L2) ELSEIF(IQ==03)THEN WRITE(NOU,'(4X,A)') ST(L1:L2) ENDIF C..................................................... DISPLAY CODICE 01 ELSEIF(N==01)THEN WRITE(*, '(T,A1)') & CHAR(INC(01)),(CHAR(INC(05)),K=01,LS+02+IX),CHAR(INC(02)) WRITE(*, '(T,A1,X,A,<01+IX>X,A1)') & CHAR(INC(06)),ST(L1:L2),CHAR(INC(06)) C..................................................... DISPLAY CODICE 02 ELSEIF(N==02)THEN WRITE(*, '(T,A1,X,A,<01+IX>X,A1)') & CHAR(INC(06)),ST(L1:L2),CHAR(INC(06)) C..................................................... DISPLAY CODICE 03 ELSEIF(N==03)THEN WRITE(*, '(T,A1,X,A,<01+IX>X,A1)') & CHAR(INC(06)),ST(L1:L2),CHAR(INC(06)) WRITE(*, '(T,A1)') & CHAR(INC(04)),(CHAR(INC(05)),K=01,LS+02+IX),CHAR(INC(03)) C..................................................... DISPLAY CODICE 04 ELSEIF(N==04)THEN WRITE(*, '(T,A1)') & CHAR(INC(01)),(CHAR(INC(05)),K=01,LS+02+IX),CHAR(INC(02)) WRITE(*, '(T,A1,X,A,<01+IX>X,A1)') & CHAR(INC(06)),ST(L1:L2),CHAR(INC(06)) WRITE(*, '(T,A1)') & CHAR(INC(04)),(CHAR(INC(05)),K=01,LS+02+IX),CHAR(INC(03)) C.................................................. DISPLAY CODICE 05:07 ELSEIF(N >04)THEN IF(N >05)WRITE(*,'(T,A1)') (CHAR(INC(05)),K=01,LS) IF(IQ==00.OR.IQ==02)WRITE(*,'(T,A)') ST(L1:L2) IF(IQ==01) WRITE(*,'(T,A,$)') ST(L1:L2) IF(IQ==01) READ (*,'(A1)') TS IF(IQ >01) WRITE(NOU,'(4X,A)') ST(L1:L2) IF(N /=06)WRITE(*,'(T,A1)') (CHAR(INC(05)),K=01,LS) ENDIF C................................................... SALTI RIGA SEGUENTI K=00 DO WHILE (K 01)WRITE(NOU,'('' '')') ENDDO C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++ORDVFL C----------------------------------------------------------------------- SUBROUTINE ORDVFL (V,IOV,IW,NA,NB,IO) C----------------------------------------------------------------------- C INDIRIZZI ORDINATI DI UN VETTORE SECONDO VALORI NUMERICI C-------------------------------------------------------------------- in C V = VETTORE OGGETTO DELL'ORDINAMENTO C IW = INIZIALIZZAZIONE ESTERNA DEL VETTORE IOV (01=SI) C NA = POSIZIONE INIZIALE DEL VETTORE V C NB = POSIZIONE FINALE DEL VETTORE V C IO = ORDINAMENTO IN SENSO 00=DECRESCENTE 01=CRESCENTE C------------------------------------------------------------------- out C IOV = VETTORE INDIRIZZI ORDINATI DI V C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C----------------------------------------- ORDVFL: DEFINIZIONE ARGOMENTI INTEGER (0004) IOV(*),IW,NA,NB,IO REAL (0004) V(*) C-------------------------------------------- ORDVFL: ALLOCABILI INTERNI INTEGER (0004),ALLOCATABLE :: NS(:),IN(:),IV(:) REAL (0004),ALLOCATABLE :: VO(:) C.................................................... CONTROLLI INIZIALI NE=NB-NA+01 IF(IW==00)IOV(NA)=NA IF(NE<=01)RETURN C......................................... CALCOLO DEL NUMERO DI BLOCCHI NEB=MAX(01,NINT(FLOAT(02*NE)**0.500)) NBL=(NE-01)/NEB+01 C................................................... ALLOCAZIONE INTERNI ALLOCATE (NS(NBL),IN(NBL),VO(NBL),IV(NB)) C.................................. INIZIALIZZAZIONE OPZIONALE INDIRIZZI J=NA-01 DO WHILE (J V(IOV(MXX)))MXX=J ENDDO IX=IOV(MXX) IOV(MXX)=IOV(I) IOV(I)=IX ENDDO VO(L)=V(IOV(NI)) IN(L)=NI NS(L)=NF ENDDO C................... ORDINAMENTO TOTALE A CONFRONTO DEI BLOCCHI ORDINATI NBI=02 IF(NBL==01)NBI=01 DO J=NA,NB MXX=01 DO L=NBI,NBL IF(VO(L) >VO(MXX))MXX=L ENDDO M=IN(MXX) IV(J)=IOV(M) VO(MXX)=-1.E+20 IF(M 00)CALL SYSTEMQQ('@CLS') WRITE(HDS,'(A50,T,A14)') HCASO(KL)(001:050), & HCASO(KL)(105:118) IX=42+(LARGH-24-42-17)/02 IF(HDATE/=' ')WRITE(HDS(IX:IX+16),'(A17)') HDATE IF (IW >00)THEN CALL HDISPL(001004,HDS) IF(KEYOK >50)CALL DISPOT(' ',00) C CALL HLMRSP(HRND,02) ELSEIF(IW <02)THEN WRITE(NOU,'(4X,A)') HDS WRITE(NOU,'(4X, (1H-))') ENDIF C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++DISPOT C----------------------------------------------------------------------- SUBROUTINE DISPOT (H,IX) C----------------------------------------------------------------------- C DISPLAY POSIZIONATO DEL CARATTERE H C----------------------------------------------------------------------- USE IFWIN INTEGER(8) FHANDLE LOGICAL(8) WSTAT TYPE(T_CONSOLE_SCREEN_BUFFER_INFO) INFOVIDEO TYPE(T_COORD) DIFINE,CURPOS C----------------------------------------------------------------------- CHARACTER(0001) H C....................................................................... FHANDLE=GETSTDHANDLE(STD_OUTPUT_HANDLE) WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) DIFINE=INFOVIDEO.DWSIZE LARGH=DIFINE.X C....................................................................... CURPOS=INFOVIDEO.DWCURSORPOSITION IRIGH=CURPOS.Y C....................................................................... LSNS=03 ;IF(IX >00)LSNS=LARGH/02-01-IX+MOD(LARGH,02) LDST=LARGH-04;IF(IX >00)LDST=LARGH/02-01+IX+MOD(LARGH,02) C....................................................................... CURPOS.X=LSNS CURPOS.Y=IRIGH-03 WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) WRITE(*,'(A1)') H C....................................................................... CURPOS.X=LDST CURPOS.Y=IRIGH-03 WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) WRITE(*,'(A1)') H C....................................................................... CURPOS.X=LSNS CURPOS.Y=IRIGH-01 WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) WRITE(*,'(A1)') H C....................................................................... CURPOS.X=LDST CURPOS.Y=IRIGH-01 WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) WRITE(*,'(A1)') H C....................................................................... CURPOS.X=00 CURPOS.Y=IRIGH WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN RETURN END C+++++INVIAP C----------------------------------------------------------------------- SUBROUTINE INVIAP(IA) C----------------------------------------------------------------------- C ATTESA PER CONSULTAZIONE DISPLAY C----------------------------------------------------------------------- USE MVAR C----------------------------------------------------------------------- CHARACTER(0001) HD CHARACTER(0032) HDSP(06) C----------------------------------------------------------------------- DATA HDSP/ 'ATTESA :::: 00:ss.dd ', & 'PAUSE ::::: 00:ss.dd ', & ' ', & 'INVIARE PER PROSEGUIRE>', & 'SEND TO EXIT> ', & ' '/ C....................................................................... IF(IA >00)THEN IDIS=001016 DO IS=IA,00,-1 DO ID=09,00,-1 WRITE(HDSP(KL)(16:20),'(I2.2,1H.,I2.2)') IS,ID CALL HDISPL(IDIS,HDSP(KL)) IDIS=010010 CALL SLEEPQQ(99) ENDDO ENDDO C....................................................................... ELSE IDIS=101010 CALL HDISPL(IDIS,HDSP(KL+03)) READ (*,'(A1)') HD ENDIF C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN RETURN END C+++++SALTO C----------------------------------------------------------------------- SUBROUTINE SALTO (HS) C----------------------------------------------------------------------- C KS >0 PROX DISPLAY CON SALTO DI KS RIGHE C =0 PROX DISPLAY SULLA STESSA RIGA C <0 PROX DISPLAY -KS RIGHE PRIMA C----------------------------------------------------------------------- USE IFWIN INTEGER(8) FHANDLE LOGICAL(8) WSTAT TYPE(T_CONSOLE_SCREEN_BUFFER_INFO) INFOVIDEO TYPE(T_COORD) DIFINE,CURPOS C....................................................................... CHARACTER( *) HS C----------------------------------------------------------------------- READ (HS(1:2),'(I2)') KS IS=KS+MAX(MIN(KS-01,00),-1) C....................................................................... FHANDLE=GETSTDHANDLE(STD_OUTPUT_HANDLE) WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) DIFINE=INFOVIDEO.DWSIZE LARGH=DIFINE.X C....................................................................... JCS=01 IF(HS(3:3)/=' ')JCS=00 C....................................................................... NV=01-JCS*MAX(MIN(IS,00),-1) DO IV=01,NV IF(IV==02)WSTAT=GETCONSOLESCREENBUFFERINFO(FHANDLE,INFOVIDEO) CURPOS=INFOVIDEO.DWCURSORPOSITION IRIGH=CURPOS.Y CURPOS.X=00 CURPOS.Y=IRIGH+IS WSTAT=SETCONSOLECURSORPOSITION(FHANDLE,CURPOS) IL=00 DO WHILE (IL <-IS.AND.IV==01.AND.JCS >00) IL=IL+01 WRITE(*,'((1H ))') ENDDO ENDDO C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++ISOMV C----------------------------------------------------------------------- FUNCTION ISOMV(IV,NV) C----------------------------------------------------------------------- C ISOMV = SOMMA DEI PRIMI NV VALORI DEL VETTORE INTERO IV C----------------------------------------------------------------------- INTEGER (0004) ISOMV,IV(*),NV C....................................................................... ISOMV=00 DO II=01,NV ISOMV=ISOMV+IV(II) ENDDO C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++IEXTR C----------------------------------------------------------------------- FUNCTION IEXTR(NM,N1,N2) C----------------------------------------------------------------------- C SCOMPOSIZIONE DI NUMERO INTERO C----------------------------------------------------------------------- C NM = NUMERO DA SCOMPORRE C N1 = CIFRA DI NM CONTATA DA DESTRA A PARTIRE DALLA QUALE VA C ESTRATTO IEXTR C N2 = NUMERO DI CIFRE (CONTATE DA N1 COMPRESA VERSO DESTRA) CHE C COMPONGONO IEXTR C----------------------------------------------------------------------- INTEGER*4 IEXTR C....................................................................... IEXTR=MOD(NM,10**N1)/(10**(N1-N2)) C....................................................................... RETURN END C+++++PDUE C----------------------------------------------------------------------- FUNCTION PDUE(F4) C----------------------------------------------------------------------- C PDUE [REAL*8] <-- F4 [REAL*4] C----------------------------------------------------------------------- INTEGER (0004) LG REAL (0008) PDUE REAL (0004) F4 CHARACTER(0016) HNUM C....................................................................... LG=MAX(00,06-MAX(00,IFIX(LOG10(ABS(F4)+1.00E-24)))) WRITE(HNUM,'(SP,F16.,SS)') F4 READ (HNUM,'(F16.0)') PDUE C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++HF08 C----------------------------------------------------------------------- FUNCTION HF08(F8) C----------------------------------------------------------------------- INTEGER (0004) LG REAL (0008) F8 CHARACTER(0016) HF08 C....................................................................... LG=MAX(00,13-MAX(00,IFIX(LOG10(ABS(SNGL(F8))+1.00E-24)))) WRITE(HF08,'(SP,F16.,SS)') F8 C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++HF04 C----------------------------------------------------------------------- FUNCTION HF04(F4) C----------------------------------------------------------------------- INTEGER (0004) LG REAL (0004) F4 CHARACTER(0016) HF04 C....................................................................... LG=MAX(00,08-MAX(00,IFIX(LOG10(ABS(F4)+1.00E-24)))) WRITE(HF04,'(SP,F16.,SS)') F4 C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++INTIN C----------------------------------------------------------------------- FUNCTION INTIN (I,J,K) C----------------------------------------------------------------------- C INTIN = 00 con J esterno all'intervallo I-K estremi inclusi C = 01 con J interno all'intervallo I-K estremi inclusi C----------------------------------------------------------------------- DFI=FLOAT(J-I) DFK=FLOAT(J-K) II=NINT(DFI/(ABS(DFI)+1.E-24))*NINT(DFK/(ABS(DFK)+1.E-24)) INTIN=01-(II*II+II)/02 C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++INTEX C----------------------------------------------------------------------- FUNCTION INTEX (I,J,K) C----------------------------------------------------------------------- C INTEX = 00 con J interno all'intervallo I-K estremi inclusi C = 01 con J esterno all'intervallo I-K estremi inclusi C----------------------------------------------------------------------- DFI=FLOAT(J-I) DFK=FLOAT(J-K) II=NINT(DFI/(ABS(DFI)+1.E-24))*NINT(DFK/(ABS(DFK)+1.E-24)) INTEX=(II*II+II)/02 C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: RETURN END C+++++ISEGN C----------------------------------------------------------------------- FUNCTION ISEGN(X,TO) C----------------------------------------------------------------------- C ISEGN / = -1 SE X<-TO/2 / = 00 SE -TO/2+TO/2 C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C....................................................................... ISEGN=NINT(X/(ABS(X)+TO)) C....................................................................... RETURN END C+++++IZERO C----------------------------------------------------------------------- FUNCTION IZERO(X,TO) C----------------------------------------------------------------------- C IZERO=01 SE X POSITIVO (>TO/2) C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C....................................................................... IZERO=MAX(00000,NINT(X/(ABS(X)+TO))) C....................................................................... RETURN END C+++++JZERO C----------------------------------------------------------------------- FUNCTION JZERO(X,TO) C----------------------------------------------------------------------- C JZERO=01 SE X NON NEGATIVO (>-TO/2) C----------------------------------------------------------------------- IMPLICIT REAL(004) (A-H,O-Z), INTEGER(004) (I-N) C....................................................................... JZERO=MIN(00001,NINT(X/(ABS(X)+TO))+01) C....................................................................... RETURN END C+++++CMLTS C----------------------------------------------------------------------- FUNCTION CMLTS(PN,X,PP) C----------------------------------------------------------------------- CMLTS=PN*MIN(X,0.000)+PP*MAX(X,0.000) C....................................................................... RETURN END C+++++MTCPU C----------------------------------------------------------------------- FUNCTION MTCPU(IDATA) C----------------------------------------------------------------------- C TEMPO MACCHINA (MTCPU) E DATA (IDATA) C----------------------------------------------------------------------- CALL GETDAT(IA,IM,IG) CALL GETTIM(IH,MI,IS,IC) IDATA=IA*10000+IM*100+IG MTCPU=360000*IH+6000*MI+100*IS+IC C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END C+++++ERRRW C----------------------------------------------------------------------- FUNCTION ERRRW(H1,II,HW) ! VIDEOLOG DEL TIPO DI ERRORE C----------------------------------------------------------------------- USE MVAR C----------------------------------------------------------------------- PARAMETER(MERR=0026) ! numero previsto di codici errore C----------------------------------------------------------------------- REAL (0004) ERRRW CHARACTER( *) H1,HW CHARACTER(0001) HERRW(05) CHARACTER(0004) HRIGA(03) CHARACTER(0028) HRRRW(05,03) CHARACTER(0060) HRRRT(MERR,03) CHARACTER(0120) H2,HHHH1,HHHH2,HH1,HH2 C----------------------------------------------------------------------- DATA HRIGA/'RIGA','ROW ',' '/ C----------------------------------------------------------------------- DATA HERRW/'m','r','g','h','f'/ C----------------------------------------------------------------------- DATA HRRRT(001:015,01)/ &'mERRORE FORMATO LETTURA ',!001 &'mMODULO INCONGRUENTE ',!002 &'mERRATO CODICE SOCIETA" ',!003 &'mERRATO CODICE ZONA ',!004 &'mERRATO CODICE TIPO CENTRALE IDRICA ',!005 &'mERRATO CODICE ZONA PARTENZA ',!006 &'mERRATO CODICE ZONA ARRIVO ',!007 &'rANNO INIZIALE ERRATO ',!008 &'rMESE INIZIALE ERRATO ',!009 &'rGIORNO INIZIALE ERRATO ',!010 &'rERRORE LUNEDI ANGELO ',!011 &'fSUPERATO MAX NUMERO=MHTZ COMBINAZIONI ZONA/SOCIETA" ',!012 &'fSUPERATO MAX NUMERO COLONNE ',!013 &'fSUPERATO MAX NUMERO=MHTZ COMBINAZIONI AGGREGATO/SOCIETA" ',!014 &'rERRATO CODICE NUMERICO FILECODE/LUNGHEZZA RECORD '/!015 C....................................................................... DATA HRRRT(001:015,02)/ &'mWRONG READING FORMAT ',!001 &'mUNFEASIBLE MODULE ',!002 &'mWRONG COMPANY IDENTIFIER ',!003 &'mWRONG ZONE IDENTIFIER ',!004 &'mWRONG HYDRO POWER PLANT TYPE IDENTIFIER ',!005 &'mWRONG START-LINE ZONE IDENTIFIER ',!006 &'mWRONG END-LINE ZONE IDENTIFIER ',!007 &'rWRONG INITIAL YEAR ',!008 &'rWRONG INITIAL MONTH ',!009 &'rWRONG INITIAL DAY ',!010 &'rWRONG ANGEL MONDAY ',!011 &'fMAX NUMBER=MHTZ OF ZONE/COMPANY COMBINATIONS EXCEEDED ',!012 &'fMAX COLUMNS NUMBER EXCEEDED ',!013 &'fMAX NUM=MHTZ OF AGGREGATE/COMPANY COMBINATIONS EXCEEDED ',!014 &'rWRONG NUMERICAL IDENTIFIER FILECODE/RECORDLENGTH '/!015 C....................................................................... DATA HRRRT(016:026,01)/ &'mSUPERATO MAX NUMERO=MEQT TIPI DI GENERAZIONE EQUIVALENTE ',!016 &'rFILE ESERCIZIO_IDROTERMICO_MGP MANCANTE/OCCUPATO ',!017 &'rERRORE IN LETTURA FILE ESERCIZIO_IDROTERMICO_MGP ',!018 &'mSUPERATO MAX NUM=MDCT DECENNI DATA INSTALL.GRUPPI TERMICI ',!019 &'mDATE INIZIO/FINE ESERCIZIO_IDROTERMICO_MGP NON ALLINEATE ',!020 &'mFORMA BREVE TERMICA: INCONGRUENZA DATI IN RECORD=002 ',!021 &'mFORMA BREVE TERMICA: NON TROVATI FILES ',!022 &'mERRATO CODICE PER ATTIVAZIONE PROTEZIONI DA COMMANDLINE ',!023 &'mIL VOLUME DI DATI NON CORRISPONDE AL NUMERO DI ZONE ',!024 &'mIL BUFFER DELLE USCITE DIGSILENT DEVE ESSERE ALLUNGATO ',!025 &'mERRORE FORMATO IN LETTURA DEL CODICE CHIAVE_HASP '/!026 C....................................................................... DATA HRRRT(016:026,02)/ &'mMAX NUMBER=MEQT OF EQUIVALENT GENERATION TYPES EXCEEDED ',!016 &'rFILE HYDROTHERMAL_OPERATION_MGP MISSING/OCCUPIED ',!017 &'rERROR READING FILE HYDROTHERMAL_OPERATION_MGP ',!018 &'mMAX NUMBER =MDCT OF THERMAL UNITS INSTALLATION DATES ',!019 &'mSTART/END DATES ON ESERCIZIO_IDROTERMICO_MGP DON"T MATCH ',!020 &'mSHORT THERMAL FORM : DATA INCONGRUENCE IN RECORD=002 ',!021 &'mSHORT THERMAL FORM : FILES WERE NOT FOUND ',!022 &'mWRONG CODE ACTIVATING PROTECTIONS BY COMMANDLINE ',!023 &'mTHE DATA VOLUME DOES NOT CORRESPOND WITH THE ZONES NUMBER ',!024 &'mDIGSILENT OUTPUT BUFFER HAS TO BE EXPANDED ',!025 &'mWRONG FORMAT READING CHIAVE_HASP CODE '/!026 C----------------------------------------------------------------------- DATA HRRRW(01:05,01)/'MODULO ', & 'ROUTINE ', & 'GRUPPO TERMICO ', & 'CENTRALE IDRICA ', & 'FILE '/ C....................................................................... DATA HRRRW(01:05,02)/'MODULE ', & 'ROUTINE ', & 'THERMAL UNIT ', & 'HYDRO POWER PLANT ', & 'FILE '/ C----------------------------------------------------------------------- ERRRW=0.000 LW=LEN(HW) IF(INTIN(048,ICHAR(HW(01:01)),057)==01)THEN READ (HW,'(I)') I2 H2=HRRRT(I2,KL) ELSE H2=HW(01:LW) ENDIF KJ=ICODE(HERRW,05,H2(01:01)) C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: IF(KJ/=00.OR.II<=01)THEN L1=LEN(H1) IF(L1 >00)THEN HH1(01:L1)=H1(01:L1) DO IL=01,L1 IF(HH1(IL:IL)==CHAR(34))HH1(IL:IL)=CHAR(39) ENDDO ENDIF L2=LEN_TRIM(H2) IF(L2 >00)THEN HH2(01:L2)=H2(01:L2) DO IL=01,L2 IF(HH2(IL:IL)==CHAR(34))HH2(IL:IL)=CHAR(39) ENDDO ENDIF C....................................................................... IF (KJ==01.AND.II >00)THEN LM=LEN_TRIM(HRRRW(KJ,KL))+01 WRITE(HHHH1,'(A,A,X,A4,X,I5.5)') HRRRW(01,KL),HH1(01:L1), & HRIGA(KL),II CALL HDISPL(201000,HHHH1) ELSEIF(KJ >00) THEN LM=LEN_TRIM(HRRRW(KJ,KL))+01 WRITE(HHHH1,'(A,A,1H:)') HRRRW(KJ,KL),HH1(01:L1) CALL HDISPL(201000,HHHH1) ELSE WRITE(HHHH1,'(A)') HH1(01:L1) CALL HDISPL(201005,HHHH1) ENDIF C....................................................................... KJ=INTEX(00,KJ,00) WRITE(HHHH2,'(A)') HH2(01+KJ:L2) L3=L2-KJ LI=00 LJ=00 DO WHILE (LJ X,''TERMINE DEL PROGRAM &MA: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)') ICP(01:05) IF(IW == 00.AND.KL == 02)WRITE(HDSPL,'(X,''END ELFO_DGS PROGRA &M: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)') ICP(01:05) IF(IW == 01.AND.KL == 01)WRITE(HDSPL,'(X, ''STOP DEL PROGRAMMA & PER ERRORE: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)')ICP(01:05) IF(IW == 01.AND.KL == 02)WRITE(HDSPL,'(X,''PROGRAM STOP BY ERR &OR CODE: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)') ICP(01:05) IF(IW == 02.AND.KL == 01)WRITE(HDSPL,'(X,''ESECUZIONE NON AUTO &RIZZATA: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)') ICP(01:05) IF(IW == 02.AND.KL == 02)WRITE(HDSPL,'(X,''PROGRAM EXECUTION D &ENIED: CPU TIME = '',3(I2.2,1H:),I2.2,1H.,I2.2)') ICP(01:05) CALL HDISPL(000004,HDSPL) IF(KEYOK >50)CALL DISPOT(' ',00) WRITE(NOU,'(/4X,A)') HDSPL WRITE(NOU,'( 4X, (1H-))') IF(IW >00)THEN IF(KL==01)CALL HDISPL(101000,' PER PROSEGUIRE>') IF(KL==02)CALL HDISPL(101000,' TO PROCEED>') ENDIF ENDIF C.................................................... TERMINE ESECUZIONE CALL SALTO('00c') CLOSE(UNIT=NOU) IF(IW <02)CLOSE(UNIT=NFC) STOP '' C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: FINE RETURN END