*DECK MACD SUBROUTINE MACD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * Macroscopic cross sections and diffusion coefficients input module. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version * *Author(s): A. Hebert * *Parameters: input/output * NENTRY number of LCM objects or files used by the operator. * HENTRY name of each LCM object or file: * HENTRY(1) : create or modification type(L_MACROLIB). * IENTRY type of each LCM object or file: * =1 LCM memory object; =2 XSM file; =3 sequential binary file; * =4 sequential ascii file. * JENTRY access of each LCM object or file: * =0 the LCM object or file is created; * =1 the LCM object or file is open for modifications; * =2 the LCM object or file is open in read-only mode. * KENTRY LCM object address or file unit number. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) TYPE(C_PTR) KENTRY(NENTRY) CHARACTER HENTRY(NENTRY)*12 *---- * LOCAL VARIABLES *---- PARAMETER (NSTATE=40) CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12 DOUBLE PRECISION DFLOTT INTEGER IPAR(NSTATE) TYPE(C_PTR) IPLIST REAL, DIMENSION(:,:), ALLOCATABLE :: ALBP *---- * PARAMETER VALIDATION. *---- IF(NENTRY.EQ.0) CALL XABORT('MACD: PARAMETER EXPECTED.') IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('MACD: LCM' 1 //' OBJECT EXPECTED AT LHS.') IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('MACD: ENT' 1 //'RY IN CREATE OR MODIFICATION MODE EXPECTED.') ITYPE=JENTRY(1) IPLIST=KENTRY(1) *---- * READ THE INPUT DATA. *---- * DEFAULT OPTIONS: IND=1 IMPX=1 ISTEP=0 IF(ITYPE.EQ.0) THEN NL=1 NGRP=0 NMIXT=0 NIFISS=1 NDG=0 NALBP=0 ILEAK=0 NW=0 NSTEP=0 IF(NENTRY.EQ.2) THEN IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('MACD' 1 //': LCM OBJECT EXPECTED AT RHS.') IF(JENTRY(2).NE.2) CALL XABORT('MACD: RHS ENTRY IN READ-ONL' 1 //'Y MODE EXPECTED.') CALL LCMEQU(KENTRY(2),IPLIST) IND=2 ENDIF ELSE IF(ITYPE.EQ.1) THEN IND=2 ENDIF IF(IND.EQ.2) THEN CALL LCMGTC(IPLIST,'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_MACROLIB') THEN TEXT12=HENTRY(1) CALL XABORT('MACD: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_MACROLIB EXPECTED.') ENDIF IND=2 CALL LCMGET(IPLIST,'STATE-VECTOR',IPAR) NGRP=IPAR(1) NMIXT=IPAR(2) NL=IPAR(3) NIFISS=IPAR(4) NDG=IPAR(7) NALBP=IPAR(8) ILEAK=IPAR(9) NW=IPAR(10) NSTEP=IPAR(11) ENDIF *---- * READ THE MAC: MODULE OPTIONS. *---- 10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.3) CALL XABORT('MACD: CHARACTER DATA EXPECTED(1).') 20 IF(TEXT4.EQ.'EDIT') THEN * READ THE PRINT INDEX. CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(1).') ELSE IF(TEXT4.EQ.'NGRO') THEN * READ THE NUMBER OF ENERGY GROUPS. IF(IND.EQ.2) CALL XABORT('MACD: NGRO IS ALREADY DEFINED.') CALL REDGET(INDIC,NGRP,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(2).') ELSE IF(TEXT4.EQ.'NMIX') THEN * READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES. IF(IND.EQ.2) CALL XABORT('MACD: NMIX IS ALREADY DEFINED.') CALL REDGET(INDIC,NMIXT,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(3).') ELSE IF(TEXT4.EQ.'DELP') THEN * READ THE MAXIMUM NUMBER OF PRECURSORS. IF(IND.EQ.2) CALL XABORT('MACD: DELP IS ALREADY DEFINED.') CALL REDGET(INDIC,NDG,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(3).') ELSE IF(TEXT4.EQ.'ANIS') THEN * READ THE SCATTERING ANISOTROPY FOR TRANSPORT THEORY CASES. IF(IND.EQ.2) CALL XABORT('MACD: NMIX IS ALREADY DEFINED.') CALL REDGET(INDIC,NL,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(4).') ELSE IF(TEXT4.EQ.'NIFI') THEN * READ THE NUMBER OF FISSILE ISOTOPES IF(IND.EQ.2) CALL XABORT('MACD: NIFISS IS ALREADY DEFINED.') CALL REDGET(INDIC,NIFISS,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(5).') ELSE IF(TEXT4.EQ.'ALBP') THEN * READ GROUP-INDEPENDENT PHYSICAL ALBEDOS CALL REDGET(INDIC,NALBP,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(6).') IF(NALBP.GT.0) THEN ALLOCATE(ALBP(NALBP,NGRP)) DO IAL=1,NALBP DO IGR=1,NGRP CALL REDGET(INDIC,NITMA,ALBP(IAL,IGR),TEXT4,DFLOTT) IF(INDIC.NE.2) CALL XABORT('MACD: REAL DATA EXPECTED.') ENDDO ENDDO CALL LCMPUT(IPLIST,'ALBEDO',NALBP*NGRP,2,ALBP) DEALLOCATE(ALBP) ELSE CALL XABORT('MACD: INVALID NUMBER OF ALBEDOS.') ENDIF IF(ITYPE.EQ.1) THEN CALL LCMGET(IPLIST,'STATE-VECTOR',IPAR) IPAR(8)=NALBP CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,IPAR) ENDIF ELSE IF(TEXT4.EQ.'STEP') THEN * STEP TO A SON DIRECTORY AND WRITE PERTURBATION VALUES. CALL REDGET(INDIC,ISTEP,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('MACD: INTEGER DATA EXPECTED(7).') WRITE(TEXT12,'(4HSTEP,I8)') ISTEP IF(IND.EQ.1) THEN CALL LCMLEN(IPLIST,TEXT12,ILENG,ITYLCM) IF(ILENG.GT.0) THEN WRITE(HSMG,'(30HMACD: PERTURBATION DIRECTORY '',A12, 1 21H'' ALREADY EXISTS IN '',A12,2H''.)') TEXT12,HENTRY(1) CALL XABORT(HSMG) ENDIF ENDIF NSTEP=MAX(NSTEP,ISTEP) CALL LCMSIX(IPLIST,TEXT12,1) IF(IMPX.GT.0) WRITE(6,'(/34H MACD: WRITE PERTURBATION VALUES O, 1 13HN DIRECTORY '',A12,6H'' OF '',A12,2H''.)') TEXT12,HENTRY(1) ELSE IF(TEXT4.EQ.'READ') THEN * INPUT NON-PERTURBED OR PERTURBED DIFFUSION COEFFICIENTS AND * CROSS SECTIONS PER MIXTURE. CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT) IF((INDIC.NE.3).OR.(TEXT4.NE.'INPU')) CALL XABORT('MACD: INPU' 1 //'T KEYWORD EXPECTED.') CALL MACXSI(IPLIST,IND,NMIXT,NGRP,NDG,NL,IMPX,NBMIX,ILEAK,NW, 1 JND) IF(ISTEP.GT.0) THEN IF(IMPX.GT.1) CALL LCMLIB(IPLIST) CALL LCMSIX(IPLIST,' ',2) ENDIF IF(JND.EQ.1) THEN GO TO 40 ELSE IF(JND.EQ.2) THEN TEXT4='STEP' GO TO 20 ENDIF ELSE IF(TEXT4.EQ.';') THEN GO TO 40 ELSE CALL XABORT('MACD: '//TEXT4//' IS AN INVALID KEY-WORD.') ENDIF GO TO 10 * 40 IF(ITYPE.EQ.0) THEN HSIGN='L_MACROLIB' CALL LCMPTC(IPLIST,'SIGNATURE',12,HSIGN) IPAR(:NSTATE)=0 IPAR(1)=NGRP IPAR(2)=NMIXT IPAR(3)=NL IPAR(4)=NIFISS IPAR(5)=0 IPAR(6)=0 IPAR(7)=NDG IPAR(8)=NALBP IPAR(9)=ILEAK IPAR(10)=NW IPAR(11)=NSTEP CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,IPAR) IF(IMPX.GT.0) WRITE(6,100) IMPX,(IPAR(I),I=1,10) ENDIF IF(IMPX.GT.1) CALL LCMLIB(IPLIST) RETURN * 100 FORMAT(/8H OPTIONS/8H -------/ 1 7H IPRINT,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/ 2 7H NGROUP,I6,28H (NUMBER OF ENERGY GROUPS)/ 3 7H NBMIX ,I6,39H (NUMBER OF MIXTURES IN THE MACROLIB)/ 4 7H NANISO,I6,34H (MAXIMUM SCATTERING ANISOTROPY)/ 5 7H NIFISS,I6,45H (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M, 6 7HIXTURE)/ 7 7H NEDMAC,I6,34H (NUMBER OF CROSS SECTION EDITS)/ 8 7H ITRANC,I6,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2, 9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/ 1 7H NLG ,I6,39H (NUMBER OF DELAYED PRECURSOR GROUPS)/ 2 7H NALB ,I6,31H (NUMBER OF PHYSICAL ALBEDOS)/ 3 7H ILEAK ,I6,40H (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/ 4 7H NW ,I6,45H (=0/1: P1-WEIGHTED INFORMATION ABSENT/PRES, 5 4HENT)) END