7. Fichiers corrigés

Catalogue de commandes :

from ..Commons import *
from ..Language.DataStructure import *
from ..Language.Syntax import *


MODI_MAIL = OPER(
    nom="MODI_MAIL",
    op=190,
    sd_prod=maillage_sdaster,
    fr=tr("Modifier un maillage par translation"),
    reentrant="o:MAILLAGE",
    reuse=SIMP(statut="c", typ=CO),
    MAILLAGE=SIMP(statut="o", typ=maillage_sdaster),
    TRANSLATION=FACT(statut="o", VECTEUR=SIMP(statut="o", typ="R", min=2, max=3)),
    INFO=SIMP(statut="f", typ="I", defaut=1, into=(1, 2)),
)

Routine de la commande bibfor/op/op0190.F90 :

subroutine op0190()
    implicit none

#include "asterc/getfac.h"
#include "asterc/getres.h"
#include "asterfort/as_allocate.h"
#include "asterfort/as_deallocate.h"
#include "asterfort/assert.h"
#include "asterfort/dismoi.h"
#include "asterfort/getvid.h"
#include "asterfort/getvr8.h"
#include "asterfort/jedema.h"
#include "asterfort/jemarq.h"
#include "asterfort/jeveuo.h"

    character(len=8) :: mesh, result
    character(len=16) :: concep, nomcmd
    character(len=19) :: chcoord
    character(len=24) :: vect_coord
    integer :: i, j, iret, dim, nbocc, nbnodes
    real(kind=8), pointer :: vect(:) => null()
    real(kind=8) :: transl(3)
    real(kind=8), pointer :: coord(:) => null()

    call jemarq()

!   read the input mesh name: maillage_sdaster, see d6.03.01, §2.1.1
    call getvid(" ", "MAILLAGE", scal=mesh, nbret=iret)
    ASSERT(iret == 1)

!   read the mesh result (must be identical to the input), see d6.03.01, §2.1.5
    call getres(result, concep, nomcmd)
    ASSERT(result == mesh)

!   check that TRANSLATION exists, see d6.03.01, §2.1.6
    call getfac('TRANSLATION', nbocc)
    ASSERT(nbocc == 1)

!   get the size of the translation vector for a dynamic allocation, see d6.03.01, §2.1.1
    call getvr8("TRANSLATION", "VECTEUR", iocc=1, nbval=0, nbret=dim)
    dim = -dim
    ASSERT(2 <= dim .and. dim <= 3)
!   allocate the vector of size 'dim'
    AS_ALLOCATE(vr=vect, size=dim)
!   read the translation vector values
    call getvr8("TRANSLATION", "VECTEUR", iocc=1, nbval=dim, vect=vect)

!   name of the jeveux vector containing the coordinates of the mesh
!   see d4.06.01 for the COORDO object and d4.06.05 for its VALE vector
    chcoord = mesh//".COORDO"
    vect_coord = chcoord//".VALE"

!   get the address and the size of this vector
    call jeveuo(vect_coord, 'E', vr=coord)
    call dismoi('NB_NO_MAILLA', mesh, 'MAILLAGE', repi=nbnodes)

!   translate the mesh
    transl = 0.d0
    transl = vect
!   loop on the nodes
    do i = 1, nbnodes
!       always 3 coordinates in .COORDO
        do j = 1, 3
            coord((i-1)*3+j) = coord((i-1)*3+j)+transl(j)
        end do
    end do

    AS_DEALLOCATE(vr=vect)

    call jedema()
end subroutine