diff options
| author | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
|---|---|---|
| committer | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
| commit | 7dfcc480ba1e19bd3232349fc733caef94034292 (patch) | |
| tree | 03ee104eb8846d5cc1a981d267687a729185d3f3 /Utilib/src/GUITOC.f | |
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Utilib/src/GUITOC.f')
| -rw-r--r-- | Utilib/src/GUITOC.f | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/Utilib/src/GUITOC.f b/Utilib/src/GUITOC.f new file mode 100644 index 0000000..1e11563 --- /dev/null +++ b/Utilib/src/GUITOC.f @@ -0,0 +1,90 @@ +*DECK GUITOC + SUBROUTINE GUITOC(INTVAR,CARVAR,NC4 ,NELEM ) +C +C------------------------------ GUITOC ------------------------------ +C +C PROGRAMME STATISTICS: +C NAME : GUITOC +C ENTRY : GUITOC +C USE : GANLIB UTILITY PROGRAM +C TRANSFERS INTEGER VARIABLE TO CHARACTER VARIABLE +C MODIFIED : 98/11/23 G. MARLEAU +C CREATION DATE +C +C ROUTINE PARAMETERS: +C INPUT +C INTVAR : INTEGER VARIABLE I(NC4,NELEM) +C NC4 : NUMBER OF CHARACTER*4 BLOCKS IN +C CARVAR TO TRANSFER IN INTVAR I +C NBELEM : NUMBER OF ELEMENTS TO TRANSFER FROM +C CARVAR +C INPUT/OUTPUT +C CARVAR : CHARACTER VARIABLE C(NELEM)*(*) +C +C------------------------------ GUITOC ------------------------------ +C + IMPLICIT NONE + INTEGER NC4,NELEM,INTVAR(NC4,NELEM) + CHARACTER CARVAR(NELEM)*(*) +C---- +C LOCAL PARAMETERS +C---- + INTEGER LENCAR,NBC4,NRESTE,IELEM,IC4,IDC,IFC + CHARACTER FMT*8,BLANK*1 + SAVE BLANK + DATA BLANK /' '/ +C---- +C FIND LENGTH OF CHARACTER VARIABLE +C---- + LENCAR=LEN(CARVAR(1)) + NBC4 =LENCAR/4 + IF(NBC4 .GE. NC4) THEN +C---- +C CHARACTER VARIABLE LARGER OF EQUAL TO SPACE IN +C INTEGER VARIABLE +C TRANSFER FROM INTEGER VARIABLE ONLY 4*NC4 ELEMENTS +C--- + WRITE(FMT,1000) NC4 + DO 100 IELEM=1,NELEM + WRITE(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NC4) + DO 101 IC4=4*NC4+1,LENCAR + WRITE(CARVAR(IELEM)(IC4:IC4),'(A1)') BLANK + 101 CONTINUE + 100 CONTINUE + ELSE +C---- +C CHARACTER VARIABLE SHORTER THAN SPACE IN +C INTEGER VARIABLE +C TRANSFER FROM INTEGER VARIABLE ONLY 4*NBC4 ELEMENTS +C AND PART OF NBC4+1 ELEMENT AS DESCRIBED BY NRESTE +C--- + WRITE(FMT,1000) NBC4 +C---- +C LENGHT OF CHARACTER VARIABLE IS A FACTOR OF 4 +C---- + DO 110 IELEM=1,NELEM + READ(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NBC4) + 110 CONTINUE + NRESTE=MOD(LENCAR,4) + IF(NRESTE .NE. 0 ) THEN +C---- +C LENGHT OF CHARACTER VARIABLE IS NOT A FACTOR OF 4 +C---- + WRITE(FMT,1001) NRESTE + IDC=4*NBC4+1 + IFC=4*NBC4+NRESTE + DO 120 IELEM=1,NELEM + WRITE(CARVAR(IELEM)(IDC:IFC),FMT) INTVAR(NBC4+1,IELEM) + 120 CONTINUE + ENDIF + ENDIF +C---- +C RETURN +C---- + RETURN +C---- +C FORMAT +C---- + 1000 FORMAT('(',I4,'A4)') + 1001 FORMAT('(A',I1,') ') + END |