diff options
Diffstat (limited to 'Dragon/src/APXCAT.f')
| -rw-r--r-- | Dragon/src/APXCAT.f | 38 |
1 files changed, 34 insertions, 4 deletions
diff --git a/Dragon/src/APXCAT.f b/Dragon/src/APXCAT.f index 78ae390..ba1cf25 100644 --- a/Dragon/src/APXCAT.f +++ b/Dragon/src/APXCAT.f @@ -46,7 +46,8 @@ PARAMETER (MAXPAR=50) INTEGER RANK,TYPE,NBYTE,DIMSR(5) INTEGER MUPLET(2*MAXPAR),MUPRHS(2*MAXPAR) - CHARACTER HSMG*131,RECNAM*80,RECNA2*80,TEXT4*4,TEXT12*12 + CHARACTER HSMG*131,RECNAM*80,RECNA2*80,REC100*100,TEXT4*4, + 1 TEXT12*12 LOGICAL COMTRE,LGERR,LGNEW(MAXPAR) *---- * ALLOCATABLE ARRAYS @@ -54,7 +55,8 @@ INTEGER, ALLOCATABLE, DIMENSION(:) :: IORRHS,JDEBAR,JARBVA,VINTE, 1 IDEBAR,IARBVA,IORIGI REAL, ALLOCATABLE, DIMENSION(:) :: VREAL - CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT_RHS + CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT_RHS, + 1 PARFMT_LHS CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: VCHAR CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: PARNAM_RHS, 1 PARNAM_LHS @@ -97,7 +99,7 @@ *---- IDEM=0 NCALS=NCAL - DO 170 ICAL=1,NCALR + DO 180 ICAL=1,NCALR *---- * COMPUTE THE MUPLET VECTOR FROM THE RHS APEX FILE *---- @@ -196,7 +198,7 @@ 1 'SAME PARAMETERS AS ELEMENTARY CALCULATION NB ',TEXT4 DEALLOCATE(JARBVA,JDEBAR,IORRHS) IDEM=IDEM+1 - GOTO 170 + GOTO 180 ELSE CALL XABORT('APXCAT: ELEMENTARY CALCULATION HAS THE '// 1 'SAME PARAMETERS AS ELEMENTARY CALCULATION NB '//TEXT4) @@ -252,7 +254,35 @@ WRITE(RECNAM,'(4Hcalc,I8)') NCALS WRITE(RECNA2,'(4Hcalc,I8)') ICAL call hdf5_copy(IPRHS,RECNA2,IPAPX,RECNAM) ! IPRHS -> IPAPX +*---- +* CREATE PARAM GROUP +*---- + CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"/PARAM") + CALL hdf5_read_data(IPAPX,"/paramdescrip/PARFMT",PARFMT_LHS) + DO 170 IPAR=1,NPAR + IF(MUPLET(IPAR).EQ.0) THEN + WRITE(HSMG,'(33HAPXCAT: UNDEFINED MUPLET ELEMENT=,I6)') IPAR + CALL XABORT(HSMG) + ENDIF + IV=MUPLET(IPAR) + WRITE(RECNAM,'(17H/paramvalues/PVAL,I8)') IPAR + WRITE(REC100,'(4Hcalc,I8,7H/PARAM/,A)') NCALS,PARNAM_LHS(IPAR) + IF(PARFMT_LHS(IPAR).EQ.'FLOTTANT') THEN + CALL hdf5_read_data(IPAPX,RECNAM,VREAL) + CALL hdf5_write_data(IPAPX,TRIM(REC100),VREAL(IV)) + DEALLOCATE(VREAL) + ELSE IF(PARFMT_LHS(IPAR).EQ.'ENTIER') THEN + CALL hdf5_read_data(IPAPX,RECNAM,VINTE) + CALL hdf5_write_data(IPAPX,TRIM(REC100),VINTE(IV)) + DEALLOCATE(VINTE) + ELSE IF(PARFMT_LHS(IPAR).EQ.'CHAINE') THEN + CALL hdf5_read_data(IPAPX,RECNAM,VCHAR) + CALL hdf5_write_data(IPAPX,TRIM(REC100),VCHAR(IV)) + DEALLOCATE(VCHAR) + ENDIF 170 CONTINUE + DEALLOCATE(PARFMT_LHS) + 180 CONTINUE * END OF LOOP ON ELEMENTARY CALCULATIONS. ******************** RETURN END |