LCPQ/irpf90
10
0
Fork 0
mirror of https://gitlab.com/scemama/irpf90.git synced 2024-12-22 04:13:33 +01:00
Code Releases Activity

More logical allocate

Browse Source
This commit is contained in:
Thomas Applencourt 2017-03-17 11:37:07 -05:00
parent 3c89b53828
commit 5379700a3d
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/templates/allocater.f90
View File

@ -9,12 +9,19 @@ SUBROUTINE allocate_{name}
CHARACTER*(9+{@size key=name/}),PARAMETER :: irp_here = 'allocate_{name}'
INTEGER :: irp_err
LOGICAL :: alloc
IF ( ALLOCATED({name}) .AND.( &
alloc = ALLOCATED({name})
IF ( alloc .AND.( &
{#l_dim}
( SIZE({name},{rank}) /= {value} ) {@sep}.OR.{/sep} &
( SIZE({name},{rank}) == {value} ) {@sep}.OR.{/sep} &
{/l_dim})) THEN
RETURN
ELSE IF (.NOT.alloc) THEN
GO TO 666
ELSE
{?do_memory} PRINT*, irp_here//': Deallocated {name}' {/do_memory}
DEALLOCATE({name},STAT=irp_err)
@ -24,10 +31,6 @@ SUBROUTINE allocate_{name}
ENDIF
GO TO 666
ELSE IF (.NOT.ALLOCATED({name})) THEN
GO TO 666
ELSE
RETURN
ENDIF
666 CONTINUE
@ -38,7 +41,7 @@ SUBROUTINE allocate_{name}
{:else}
ALLOCATE({name} ({dim}[*]), STAT=irp_err)
{/do_corray}
IF (irp_err /= 0) then
PRINT*, irp_here//': Allocation failed: {name}'
PRINT*,' size: {dim}'