diff options
Diffstat (limited to 'Dragon/src/APXSX2.f')
| -rw-r--r-- | Dragon/src/APXSX2.f | 529 |
1 files changed, 529 insertions, 0 deletions
diff --git a/Dragon/src/APXSX2.f b/Dragon/src/APXSX2.f new file mode 100644 index 0000000..cbbbde5 --- /dev/null +++ b/Dragon/src/APXSX2.f @@ -0,0 +1,529 @@ +*DECK APXSX2 + SUBROUTINE APXSX2(IPAPX,IPTEMP,NGRP,NL,NMAC,NISO,NMIL,IMIL,ITRANC, + 1 RECNAM,NOMMAC,TYPISO,NOMREA,IPERM,CONCES,B2) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover the cross sections of an elementary calculation and single +* mixture in the edit structure and copy them in the Apex file. +* +*Copyright: +* Copyright (C) 2025 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 +* IPAPX pointer to the Apex file. +* IPTEMP pointer to the edit structure. +* NGRP number of energy groups in the Apex file. +* NL number of Legendre orders. +* NMAC number of macroscopic sets in the Apex file. +* NISO number of particularized isotopes in the Apex file. +* NMIL number of mixtures in the Apex file. +* ITRANC +* IMIL mixture index. +* RECNAM character identification of calculation. +* NOMMAC names of the macroscopic sets. +* TYPISO types of the particularized isotopes. +* NOMREA name of the Apex reaction. +* IPERM pointer to the particularized isotopes in the edit structure. +* CONCES number densities of particularized isotopes. +* B2 buckling. +* +*----------------------------------------------------------------------- +* + USE GANLIB + USE hdf5_wrap +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPAPX,IPTEMP,IPERM(NISO) + CHARACTER*80 RECNAM + CHARACTER*4 TYPISO(NISO) + CHARACTER*8 NOMMAC(NMAC) + CHARACTER*12 NOMREA + INTEGER NGRP,NL,NMAC,NISO,IMIL,ITRANC + REAL B2,CONCES(NISO) +*---- +* LOCAL VARIABLES +*---- + TYPE(C_PTR) JPEDIT,KPEDIT + INTEGER RANK,TYPE,NBYTE,DIMSR(5) + CHARACTER RECNAM2*80,CM*2,TEXT12*12 +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: JSO,ITYPR,IPOS,NJJ,IJJ + REAL, ALLOCATABLE, DIMENSION(:) :: WORK1D,WO1D + REAL, ALLOCATABLE, DIMENSION(:,:) :: WORK2D,WP2D,WF2D,WO2D + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WORK3D,WP3D,WF3D,WO3D + REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: WP4D,WF4D,WO4D +*---- +* FIND NISOP, NISOF AND NISOO +*---- + NISOF=0 + NISOP=0 + NISOO=0 + IF(NISO.EQ.0) GO TO 10 + ALLOCATE(JSO(NISO)) + DO ISO=1,NISO + IF(TYPISO(ISO).EQ.'FISS') THEN + NISOF=NISOF+1 + JSO(ISO)=NISOF + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + NISOP=NISOP+1 + JSO(ISO)=NISOP + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + NISOO=NISOO+1 + JSO(ISO)=NISOO + ENDIF + ENDDO + IF(NISOF.GT.0) THEN + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"mic/fiss/") + ENDIF + IF(NISOP.GT.0) THEN + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"mic/f.p. /") + ENDIF + IF(NISOO.GT.0) THEN + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"mic/othe/") + ENDIF +*---- +* RECOVER DIFF AND SCAT OF PARTICULARIZED ISOTOPES +*---- + IF((NOMREA.EQ.'DIFF').OR.(NOMREA.EQ.'SCAT')) THEN + ALLOCATE(WF3D(NGRP,NL,NISOF),WP3D(NGRP,NL,NISOP), + 1 WO3D(NGRP,NL,NISOO),WF4D(NGRP,NGRP,NL,NISOF), + 2 WP4D(NGRP,NGRP,NL,NISOP),WO4D(NGRP,NGRP,NL,NISOO)) + WF3D(:NGRP,:NL,:NISOF)=0.0 + WP3D(:NGRP,:NL,:NISOP)=0.0 + WO3D(:NGRP,:NL,:NISOO)=0.0 + WF4D(:NGRP,:NGRP,:NL,:NISOF)=0.0 + WP4D(:NGRP,:NGRP,:NL,:NISOP)=0.0 + WO4D(:NGRP,:NGRP,:NL,:NISOO)=0.0 + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + DO IL=1,NL + WRITE(CM,'(I2.2)') IL-1 + CALL LCMLEN(IPERM(ISO),'SCAT'//CM,ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + FACT=2.0*REAL(IL)-1.0 + ALLOCATE(WORK2D(NGRP,NL),WORK3D(NGRP,NGRP,NL),ITYPR(NL)) + CALL XDRLGS(IPERM(ISO),-1,0,0,NL-1,1,NGRP,WORK2D,WORK3D, + 1 ITYPR) + IF(TYPISO(ISO).EQ.'FISS') THEN + WF3D(:,:,JSO(ISO))=WORK2D(:,:) + WF4D(:,:,:,JSO(ISO))=WORK3D(:,:,:)*FACT + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WP3D(:,:,JSO(ISO))=WORK2D(:,:) + WP4D(:,:,:,JSO(ISO))=WORK3D(:,:,:)*FACT + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WO3D(:,:,JSO(ISO))=WORK2D(:,:) + WO4D(:,:,:,JSO(ISO))=WORK3D(:,:,:)*FACT + ENDIF + DEALLOCATE(ITYPR,WORK3D,WORK2D) + ENDDO + ENDDO + ! remove (n,2n) from 'DIFF' + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + CALL LCMLEN(IPERM(ISO),'N2N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + ALLOCATE(WORK1D(NGRP)) + CALL LCMGET(IPERM(ISO),'N2N',WORK1D) + IF(TYPISO(ISO).EQ.'FISS') THEN + WF3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WP3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WO3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-WORK1D(:) + ENDIF + DEALLOCATE(WORK1D) + ENDIF + ENDDO + ! remove (n,3n) from 'DIFF' + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + CALL LCMLEN(IPERM(ISO),'N3N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + ALLOCATE(WORK1D(NGRP)) + CALL LCMGET(IPERM(ISO),'N3N',WORK1D) + IF(TYPISO(ISO).EQ.'FISS') THEN + WF3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-2.0*WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WP3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-2.0*WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WO3D(:,1,JSO(ISO))=WF3D(:,1,JSO(ISO))-2.0*WORK1D(:) + ENDIF + DEALLOCATE(WORK1D) + ENDIF + ENDDO + IF(NOMREA.EQ.'DIFF') THEN + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_write_data(IPAPX,RECNAM2,WF3D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_write_data(IPAPX,RECNAM2,WP3D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_write_data(IPAPX,RECNAM2,WO3D) + ENDIF + ELSE IF(NOMREA.EQ.'SCAT') THEN + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_write_data(IPAPX,RECNAM2,WF4D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_write_data(IPAPX,RECNAM2,WP4D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_write_data(IPAPX,RECNAM2,WO4D) + ENDIF + ENDIF + DEALLOCATE(WO4D,WP4D,WF4D,WO3D,WP3D,WF3D) + GO TO 10 + ENDIF +*---- +* RECOVER OTHER REACTIONS OF PARTICULARIZED ISOTOPES +*---- + ALLOCATE(WF2D(NGRP,NISOF),WP2D(NGRP,NISOP),WO2D(NGRP,NISOO)) + WF2D(:NGRP,:NISOF)=0.0 + WP2D(:NGRP,:NISOP)=0.0 + WO2D(:NGRP,:NISOO)=0.0 + IF(NOMREA.EQ.'ABSO') THEN + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + CALL LCMLEN(IPERM(ISO),'NTOT0',ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + ALLOCATE(WORK1D(NGRP)) + CALL LCMGET(IPERM(ISO),'NTOT0',WORK1D) + IF(TYPISO(ISO).EQ.'FISS') THEN + WF2D(:,JSO(ISO))=WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WP2D(:,JSO(ISO))=WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WO2D(:,JSO(ISO))=WORK1D(:) + ENDIF + DEALLOCATE(WORK1D) + ENDDO + ! remove 'DIFF' from 'TOTA' + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + IF(TYPISO(ISO).EQ.'FISS') THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_info(IPAPX,RECNAM2,RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.EQ.99) CALL XABORT('APXSX2: MISSING DIFF INFO(1).') + CALL hdf5_read_data(IPAPX,RECNAM2,WF3D) + WF2D(:,JSO(ISO))=WF2D(:,JSO(ISO))-WF3D(:,1,JSO(ISO)) + DEALLOCATE(WF3D) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_info(IPAPX,RECNAM2,RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.EQ.99) CALL XABORT('APXSX2: MISSING DIFF INFO(2).') + CALL hdf5_read_data(IPAPX,RECNAM2,WP3D) + WP2D(:,JSO(ISO))=WP2D(:,JSO(ISO))-WP3D(:,1,JSO(ISO)) + DEALLOCATE(WP3D) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_info(IPAPX,RECNAM2,RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.EQ.99) CALL XABORT('APXSX2: MISSING DIFF INFO(3).') + CALL hdf5_read_data(IPAPX,RECNAM2,WO3D) + WO2D(:,JSO(ISO))=WO2D(:,JSO(ISO))-WO3D(:,1,JSO(ISO)) + DEALLOCATE(WO3D) + ENDIF + ENDDO + ELSE + IF(NOMREA.EQ.'TOTA') THEN + TEXT12='NTOT0' + ELSE IF(NOMREA.EQ.'TOT1') THEN + TEXT12='NTOT1' + ELSE IF(NOMREA.EQ.'NUFI') THEN + TEXT12='NUSIGF' + ELSE IF(NOMREA.EQ.'FISS') THEN + TEXT12='NFTOT' + ELSE IF(NOMREA.EQ.'ENER') THEN + TEXT12='H-FACTOR' + ELSE IF((NOMREA.EQ.'CORR').AND.(ITRANC.EQ.1).AND.(NL.GE.2)) THEN + TEXT12='SIGS01' + ELSE IF((NOMREA.EQ.'CORR').AND.(ITRANC.EQ.2)) THEN + TEXT12='TRANC' + ELSE + TEXT12=NOMREA + ENDIF + DO ISO=1,NISO + IF(.NOT.C_ASSOCIATED(IPERM(ISO))) CYCLE + CALL LCMLEN(IPERM(ISO),TEXT12,ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + ALLOCATE(WORK1D(NGRP)) + CALL LCMGET(IPERM(ISO),TEXT12,WORK1D) + IF(TYPISO(ISO).EQ.'FISS') THEN + WF2D(:,JSO(ISO))=WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WP2D(:,JSO(ISO))=WORK1D(:) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WO2D(:,JSO(ISO))=WORK1D(:) + ENDIF + DEALLOCATE(WORK1D) + ENDDO + IF(NOMREA.EQ.'ENER') THEN + WF2D(:,:)=WF2D(:,:)*1.0E-6 + WP2D(:,:)=WP2D(:,:)*1.0E-6 + WO2D(:,:)=WO2D(:,:)*1.0E-6 + ELSE IF(NOMREA.EQ.'LEAK') THEN + WF2D(:,:)=WF2D(:,:)*B2 + WP2D(:,:)=WP2D(:,:)*B2 + WO2D(:,:)=WO2D(:,:)*B2 + ENDIF + ENDIF + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),TRIM(NOMREA) + CALL hdf5_write_data(IPAPX,RECNAM2,WF2D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),TRIM(NOMREA) + CALL hdf5_write_data(IPAPX,RECNAM2,WP2D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),TRIM(NOMREA) + CALL hdf5_write_data(IPAPX,RECNAM2,WO2D) + ENDIF + DEALLOCATE(WO2D,WP2D,WF2D) +*---- +* RECOVER DIFF AND SCAT OF MACROSCOPIC SETS +*---- + 10 CALL LCMSIX(IPTEMP,'MACROLIB',1) + JPEDIT=LCMGID(IPTEMP,'GROUP') + IF(NMAC.GT.0) THEN + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"mac/TOTAL/") + ENDIF + DO IMAC=1,NMAC + IF(NOMMAC(IMAC).EQ.'TOTAL') THEN + IF((NOMREA.EQ.'DIFF').OR.(NOMREA.EQ.'SCAT')) THEN + ALLOCATE(WO2D(NGRP,NL),WO3D(NGRP,NGRP,NL)) + WO2D(:NGRP,:NL)=0.0 + WO3D(:NGRP,:NGRP,:NL)=0.0 + DO IGR=1,NGRP + KPEDIT=LCMGIL(JPEDIT,IGR) + ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),WORK1D(NGRP*NMIL)) + DO IL=1,NL + WRITE(CM,'(I2.2)') IL-1 + CALL LCMLEN(KPEDIT,'SCAT'//CM,ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + CALL LCMGET(KPEDIT,'IJJS'//CM,IJJ) + CALL LCMGET(KPEDIT,'NJJS'//CM,NJJ) + CALL LCMGET(KPEDIT,'IPOS'//CM,IPOS) + CALL LCMGET(KPEDIT,'SCAT'//CM,WORK1D) + IPO=IPOS(IMIL) + J2=IJJ(IMIL) + J1=IJJ(IMIL)-NJJ(IMIL)+1 + DO JGR=J2,J1,-1 + WO2D(JGR,IL)=WO2D(JGR,IL)+WORK1D(IPO) + WO3D(IGR,JGR,IL)=WORK1D(IPO)*REAL(2*IL-1) + IPO=IPO+1 + ENDDO + ENDDO ! IL + DEALLOCATE(WORK1D,IPOS,NJJ,IJJ) + ! remove (n,2n) from 'DIFF' + CALL LCMLEN(KPEDIT,'N2N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + ALLOCATE(WORK1D(NMIL)) + CALL LCMGET(KPEDIT,'N2N',WORK1D) + WO2D(IGR,1)=WO2D(IGR,1)-WORK1D(IMIL) + DEALLOCATE(WORK1D) + ENDIF + ! remove (n,2n) from 'DIFF' + CALL LCMLEN(KPEDIT,'N2N',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + ALLOCATE(WORK1D(NMIL)) + CALL LCMGET(KPEDIT,'N2N',WORK1D) + WO2D(IGR,1)=WO2D(IGR,1)-2.0*WORK1D(IMIL) + DEALLOCATE(WORK1D) + ENDIF + ENDDO ! IGR + IF(NOMREA.EQ.'DIFF') THEN + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_write_data(IPAPX,RECNAM2,WO2D) + ELSE IF(NOMREA.EQ.'SCAT') THEN + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_write_data(IPAPX,RECNAM2,WO3D) + ENDIF + DEALLOCATE(WO3D,WO2D) +*---- +* RECOVER OTHER REACTIONS OF MACROSCOPIC SETS +*---- + ELSE IF(NOMREA.EQ.'ABSO') THEN + ALLOCATE(WO1D(NGRP)) + WO1D(:NGRP)=0.0 + DO IGR=1,NGRP + KPEDIT=LCMGIL(JPEDIT,IGR) + CALL LCMLEN(KPEDIT,'NTOT0',ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + ALLOCATE(WORK1D(NMIL)) + CALL LCMGET(KPEDIT,'NTOT0',WORK1D) + WO1D(IGR)=WORK1D(IMIL) + DEALLOCATE(WORK1D) + ENDDO + ! remove 'DIFF' from 'TOTA' + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_info(IPAPX,RECNAM2,RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.EQ.99) CALL XABORT('APXSX2: MISSING DIFF INFO(4).') + CALL hdf5_read_data(IPAPX,RECNAM2,WO2D) + WO1D(:)=WO1D(:)-WO2D(:,1) + DEALLOCATE(WO2D) + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'ABSO' + CALL hdf5_write_data(IPAPX,RECNAM2,WO1D) + DEALLOCATE(WO1D) + ELSE + IF(NOMREA.EQ.'TOTA') THEN + TEXT12='NTOT0' + ELSE IF(NOMREA.EQ.'TOT1') THEN + TEXT12='NTOT1' + ELSE IF(NOMREA.EQ.'NUFI') THEN + TEXT12='NUSIGF' + ELSE IF(NOMREA.EQ.'FISS') THEN + TEXT12='NFTOT' + ELSE IF(NOMREA.EQ.'ENER') THEN + TEXT12='H-FACTOR' + ELSE IF(NOMREA.EQ.'LEAK') THEN + TEXT12='DIFF' + ELSE + TEXT12=NOMREA + ENDIF + ALLOCATE(WO1D(NGRP)) + WO1D(:NGRP)=0.0 + DO IGR=1,NGRP + KPEDIT=LCMGIL(JPEDIT,IGR) + CALL LCMLEN(KPEDIT,TEXT12,ILONG,ITYLCM) + IF(ILONG.EQ.0) CYCLE + ALLOCATE(WORK1D(NMIL)) + CALL LCMGET(KPEDIT,TEXT12,WORK1D) + WO1D(IGR)=WORK1D(IMIL) + DEALLOCATE(WORK1D) + ENDDO + IF(NOMREA.EQ.'ENER') THEN + WO1D(:)=WO1D(:)*1.0E-6 + ELSE IF(NOMREA.EQ.'LEAK') THEN + WO1D(:)=WO1D(:)*B2 + ENDIF + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_write_data(IPAPX,RECNAM2,WO1D) + DEALLOCATE(WO1D) + ENDIF + ELSE IF(NOMMAC(IMAC).EQ.'RESIDUAL') THEN + ! substract particularized contributions + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"mac/RESIDUAL/") + IF(NOMREA.EQ.'DIFF') THEN + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_read_data(IPAPX,RECNAM2,WORK2D) + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_read_data(IPAPX,RECNAM2,WF3D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_read_data(IPAPX,RECNAM2,WP3D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_read_data(IPAPX,RECNAM2,WO3D) + ENDIF + DO ISO=1,NISO + CONC=CONCES(ISO) + IF(TYPISO(ISO).EQ.'FISS') THEN + WORK2D(:,:)=WORK2D(:,:)-CONC*WF3D(:,:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WORK2D(:,:)=WORK2D(:,:)-CONC*WP3D(:,:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WORK2D(:,:)=WORK2D(:,:)-CONC*WO3D(:,:,JSO(ISO)) + ENDIF + ENDDO + IF(NISOF.GT.0) DEALLOCATE(WF3D) + IF(NISOP.GT.0) DEALLOCATE(WP3D) + IF(NISOO.GT.0) DEALLOCATE(WO3D) + WRITE(RECNAM2,'(A,13Hmac/RESIDUAL/,A)') TRIM(RECNAM),'DIFF' + CALL hdf5_write_data(IPAPX,RECNAM2,WORK2D) + DEALLOCATE(WORK2D) + ELSE IF(NOMREA.EQ.'SCAT') THEN + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_read_data(IPAPX,RECNAM2,WORK3D) + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_read_data(IPAPX,RECNAM2,WF4D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_read_data(IPAPX,RECNAM2,WP4D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_read_data(IPAPX,RECNAM2,WO4D) + ENDIF + DO ISO=1,NISO + CONC=CONCES(ISO) + IF(TYPISO(ISO).EQ.'FISS') THEN + WORK3D(:,:,:)=WORK3D(:,:,:)-CONC*WF4D(:,:,:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WORK3D(:,:,:)=WORK3D(:,:,:)-CONC*WP4D(:,:,:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WORK3D(:,:,:)=WORK3D(:,:,:)-CONC*WO4D(:,:,:,JSO(ISO)) + ENDIF + ENDDO + IF(NISOF.GT.0) DEALLOCATE(WF4D) + IF(NISOP.GT.0) DEALLOCATE(WP4D) + IF(NISOO.GT.0) DEALLOCATE(WO4D) + WRITE(RECNAM2,'(A,13Hmac/RESIDUAL/,A)') TRIM(RECNAM),'SCAT' + CALL hdf5_write_data(IPAPX,RECNAM2,WORK3D) + DEALLOCATE(WORK3D) + ELSE + WRITE(RECNAM2,'(A,10Hmac/TOTAL/,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_read_data(IPAPX,RECNAM2,WORK1D) + IF(NISOF.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/fiss/,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_read_data(IPAPX,RECNAM2,WF2D) + ENDIF + IF(NISOP.GT.0) THEN + WRITE(RECNAM2,'(A,10Hmic/f.p. /,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_read_data(IPAPX,RECNAM2,WP2D) + ENDIF + IF(NISOO.GT.0) THEN + WRITE(RECNAM2,'(A,9Hmic/othe/,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_read_data(IPAPX,RECNAM2,WO2D) + ENDIF + DO ISO=1,NISO + CONC=CONCES(ISO) + IF(TYPISO(ISO).EQ.'FISS') THEN + WORK1D(:)=WORK1D(:)-CONC*WF2D(:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'F.P.') THEN + WORK1D(:)=WORK1D(:)-CONC*WP2D(:,JSO(ISO)) + ELSE IF(TYPISO(ISO).EQ.'OTHE') THEN + WORK1D(:)=WORK1D(:)-CONC*WO2D(:,JSO(ISO)) + ENDIF + ENDDO + IF(NISOF.GT.0) DEALLOCATE(WF2D) + IF(NISOP.GT.0) DEALLOCATE(WP2D) + IF(NISOO.GT.0) DEALLOCATE(WO2D) + WRITE(RECNAM2,'(A,13Hmac/RESIDUAL/,A)') TRIM(RECNAM), + 1 TRIM(NOMREA) + CALL hdf5_write_data(IPAPX,RECNAM2,WORK1D) + DEALLOCATE(WORK1D) + ENDIF + ENDIF + ENDDO + CALL LCMSIX(IPTEMP,' ',2) + IF(NISO.GT.0) DEALLOCATE(JSO) + RETURN + END |