diff options
Diffstat (limited to 'Trivac/src/FLD.f')
| -rwxr-xr-x | Trivac/src/FLD.f | 178 |
1 files changed, 178 insertions, 0 deletions
diff --git a/Trivac/src/FLD.f b/Trivac/src/FLD.f new file mode 100755 index 0000000..6900797 --- /dev/null +++ b/Trivac/src/FLD.f @@ -0,0 +1,178 @@ +*DECK FLD + SUBROUTINE FLD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Multigroup flux solution operator for BIVAC and TRIVAC. +* +*Copyright: +* Copyright (C) 2002 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_FLUX); +* HENTRY(2): read-only type(L_SYSTEM); +* HENTRY(3): read-only type(L_TRACK); +* HENTRY(4): optional read-only 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. +* +*Comments: +* The FLUD: calling specifications are: +* FLUX := FLUD: [ FLUX ] SYST TRACK [ MACRO ] :: (flud\_data) ; +* where +* FLUX : name of the \emph{lcm} object (type L\_FLUX) containing the +* solution. If FLUX appears on the RHS, the solution previously stored in +* FLUX is used to initialize the new iterative process; otherwise, a uniform +* unknown vector is used. +* SYST : name of the \emph{lcm} object (type L\_SYSTEM) containing the +* system matrices. +* TRACK : name of the \emph{lcm} object (type L\_TRACK) containing the +* \emph{tracking}. +* MACRO : name of the optional \emph{lcm} object (type L\_MACROLIB) +* containing the cross sections. This object is only used to set a link to +* the \emph{macrolib} name inside the \emph{flux} object. By default, the +* name of the \emph{macrolib} is recovered from the link in the +* \emph{system} object. +* flud\_data}] : structure containing the data to module FLUD:} +* +*----------------------------------------------------------------------- +* + 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 TEXT12*12,TITLE*72,CMODUL*12,HSIGN*12 + LOGICAL REC,LREL + INTEGER IGP(NSTATE),ITR(NSTATE) + TYPE(C_PTR) IPTRK,IPSYS,IPFLUX + INTEGER, DIMENSION(:), ALLOCATABLE :: MAT,IDL + REAL, DIMENSION(:), ALLOCATABLE :: VOL +*---- +* PARAMETER VALIDATION +*---- + LREL=(JENTRY(1).EQ.1) + IF(NENTRY.LE.1) CALL XABORT('FLD: TWO PARAMETERS EXPECTED.') + IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('FLD: LCM ' + 1 //'OBJECT EXPECTED AT LHS.') + IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('FLD: ENTR' + 1 //'Y IN CREATE OR MODIFICATION MODE EXPECTED.') + IF((JENTRY(2).NE.2).OR.((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))) + 1 CALL XABORT('FLD: LCM OBJECT IN READ-ONLY MODE EXPECTED AT RHS.') + IF(JENTRY(1).EQ.1) THEN + CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_FLUX') THEN + TEXT12=HENTRY(1) + CALL XABORT('FLD: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_FLUX EXPECTED.') + ENDIF + ENDIF + CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_SYSTEM') THEN + TEXT12=HENTRY(2) + CALL XABORT('FLD: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_SYSTEM EXPECTED.') + ENDIF + HSIGN='L_FLUX' + CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN) + TEXT12=HENTRY(2) + CALL LCMPTC(KENTRY(1),'LINK.SYSTEM',12,TEXT12) + IPFLUX=KENTRY(1) + IPSYS=KENTRY(2) + REC=(JENTRY(1).EQ.1) +*---- +* RECOVER IPTRK POINTER AND VALIDATE IT +*---- + IF(NENTRY.EQ.4) THEN + CALL LCMGTC(KENTRY(4),'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_MACROLIB') THEN + TEXT12=HENTRY(4) + CALL XABORT('FLD: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_MACROLIB EXPECTED.') + ENDIF + TEXT12=HENTRY(4) + ELSE + CALL LCMGTC(IPSYS,'LINK.MACRO',12,TEXT12) + ENDIF + CALL LCMPTC(KENTRY(1),'LINK.MACRO',12,TEXT12) + CALL LCMGTC(IPSYS,'LINK.TRACK',12,TEXT12) + CALL LCMPTC(KENTRY(1),'LINK.TRACK',12,TEXT12) + DO 10 I=1,NENTRY + IF(HENTRY(I).EQ.TEXT12) THEN + IPTRK=KENTRY(I) + CALL LCMGTC(IPTRK,'SIGNATURE',12,HSIGN) + IF(HSIGN.NE.'L_TRACK') THEN + TEXT12=HENTRY(I) + CALL XABORT('FLD: SIGNATURE OF '//TEXT12//' IS '//HSIGN// + 1 '. L_TRACK EXPECTED.') + ENDIF + CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL) + IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)) CALL XABORT('FLD: L' + 1 //'CM OBJECT EXPECTED TO CONTAIN THE TRACKING.') + GO TO 20 + ENDIF + 10 CONTINUE + CALL XABORT('FLD: UNABLE TO FIND A POINTER TO TRACKING.') +*---- +* RECOVER GENERAL TRACKING INFORMATION +*---- + 20 CALL LCMGET(IPTRK,'STATE-VECTOR',IGP) + NEL=IGP(1) + NUN=IGP(2) + NLF=0 + IF(CMODUL.EQ.'BIVAC') THEN + NLF=IGP(14) + ELSE IF(CMODUL.EQ.'TRIVAC') THEN + NLF=IGP(30) + ENDIF + ALLOCATE(MAT(NEL),VOL(NEL),IDL(NEL)) + CALL LCMGET(IPTRK,'MATCOD',MAT) + CALL LCMGET(IPTRK,'VOLUME',VOL) + CALL LCMGET(IPTRK,'KEYFLX',IDL) + CALL LCMLEN(IPTRK,'TITLE',LENGT,ITYLCM) + IF(LENGT.GT.0) THEN + CALL LCMGTC(IPTRK,'TITLE',72,TITLE) + ELSE + TITLE='*** NO TITLE PROVIDED ***' + ENDIF +*---- +* RECOVER GENERAL L_SYSTEM INFORMATION +*---- + CALL LCMGET(IPSYS,'STATE-VECTOR',ITR) + NGRP=ITR(1) + LL4=ITR(2) + ITY=ITR(4) + NBMIX=ITR(7) + IF((ITY.EQ.11).OR.(ITY.EQ.13)) LL4=LL4*NLF/2 +*---- +* COMPUTE THE FLUX +*---- + CALL FLDDRV(CMODUL,IPTRK,IPSYS,REC,NEL,LL4,ITY,NUN,NBMIX,MAT,VOL, + 1 IDL,NGRP,TITLE,LREL,IPFLUX) +*---- +* RELEASE GENERAL TRACKING INFORMATION +*---- + DEALLOCATE(IDL,VOL,MAT) + RETURN + END |