10
0
mirror of https://gitlab.com/scemama/irpf90.git synced 2024-06-02 11:25:19 +02:00

More logical allocate

This commit is contained in:
Thomas Applencourt 2017-03-17 11:37:07 -05:00
parent 3c89b53828
commit 5379700a3d

View File

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