1 | include(dom.inc)
   2 | 
   3 |       PROGRAM predatas
   4 | 
   5 | !       ================================================================!
   6 | !                                                                       !
   7 | !       predatas.F: This program makes all the geometrical              !
   8 | !                   pre-processing in Prissma.                          !
   9 | !                                                                       !
  10 | !       author    : J. AMAYA (october 2007)                             !
  11 | !                                                                       !
  12 | !       ================================================================!
  13 | 
  14 | !        USE datas
  15 | 
  16 |         IMPLICIT NONE
  17 | 
  18 |         include 'dom_constants.h'
  19 | 
  20 |         DOM_INT      :: ndirs, meshtype, i, quadorder, n
  21 | 
  22 |         DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: s
  23 | 
  24 |         CHARACTER*80 :: file1, file2, file3, path, meshfile, inpath
  25 |         CHARACTER*80 :: quadtype
  26 | 
  27 | !       ---------------------------------!
  28 | !       Opening and reading choices file !
  29 | !       ---------------------------------!
  30 | 
  31 |         OPEN(1, FILE="predatas.choices", FORM='formatted')
  32 | 
  33 |         READ(1,*) meshfile
  34 |         READ(1,*) inpath
  35 |         READ(1,*) meshtype
  36 |         READ(1,*) path
  37 |         READ(1,*) quadtype
  38 |         READ(1,*) quadorder
  39 | 
  40 |         IF (quadtype.eq.'PERSO') THEN
  41 |           READ(1,*) ndirs
  42 |           print*, ndirs
  43 |           IF (ALLOCATED(s))  DEALLOCATE(s)
  44 |           ALLOCATE(s(4,ndirs))
  45 |           DO i=1,ndirs
  46 |             READ(1,*) (s(n,i),n=1,4)
  47 |           ENDDO
  48 |         ENDIF
  49 | 
  50 |         CLOSE(1)
  51 | 
  52 | !       ---------------------!
  53 | !       Calculate directions !
  54 | !       ---------------------!
  55 | 
  56 |         IF (quadtype.eq.SNDOM) THEN
  57 |           ndirs=quadorder*(quadorder+2)
  58 |           IF (ALLOCATED(s))  DEALLOCATE(s)
  59 |           ALLOCATE(s(4,ndirs))
  60 |           CALL createdirections(quadtype, quadorder, inpath, ndirs, s)
  61 |         ELSE IF (quadtype.eq.'PERSO') THEN
  62 |           WRITE (*,*) 'Parameters for the directions from the .choices'
  63 |         ELSE IF (quadtype.eq.'2D') THEN
  64 |           ndirs = quadorder
  65 |           IF (ALLOCATED(s))  DEALLOCATE(s)
  66 |           ALLOCATE(s(4,ndirs))
  67 |           CALL quadrature2D(s, ndirs)
  68 |         ELSE
  69 |           WRITE (*,*) 'Currently only SNDOM quadrature is allowed'
  70 |           STOP
  71 |         ENDIF
  72 | 
  73 | !       ------------------------------------!
  74 | !       Creation of vertex, faces and cells !
  75 | !       ------------------------------------!
  76 | 
  77 |         SELECTCASE(meshtype)
  78 |           CASE(0)
  79 |             CALL test2dom
  80 |           CASE(1)
  81 |             file1 = trim(meshfile)//".coor"
  82 |             file2 = trim(meshfile)//".conn"
  83 |             file3 = trim(meshfile)//".exBound"
  84 |             CALL avbp2dom(file1, file2, file3)
  85 |           CASE(2)
  86 |             file1 = trim(meshfile)
  87 |             CALL gambit2dom(file1)
  88 |           CASE DEFAULT
  89 |             WRITE(*,*) "Error, unknown mesh type: ", meshtype
  90 |             STOP
  91 |         ENDSELECT
  92 | 
  93 | !       ------------------------!
  94 | !       Link neighbouring cells !
  95 | !       ------------------------!
  96 |         WRITE(*,*) " Creating all links..."
  97 | 
  98 |         CALL create_cell_link(ndirs, s)
  99 | !       CALL testlinking
 100 | 
 101 | !       ---------------------------------!
 102 | !       Write geometry in Prissma format !
 103 | !       ---------------------------------!
 104 | 
 105 |         CALL writeinfiles(path, ndirs, s)
 106 | 
 107 |         WRITE(*,*)
 108 |         WRITE(*,*) " PRISSMA input files successfully written !"
 109 |         WRITE(*,*)
 110 | 
 111 |       END PROGRAM predatas