mod_write_solutions.f

Go to the documentation of this file.

!     **************************
      MODULE mod_write_solutions
!     **************************
!
!***********************************************************************
! PARTEL
!***********************************************************************
!
!BRIEF    Writing field informations for partel
!
        IMPLICIT NONE
        CONTAINS
!     **************************
      SUBROUTINE write_solutions
!     **************************
     &   (fformat, nbor, knogl, ndp_bnd,
     &    nelebd, ninp, nplan, ikles, times, knolg, date,
     &    nelem_p, npoin_p, nptfr_p, ubor, hbor, chbord, tbor,
     &    vbor, btbor, atbor, liubor, lihbor, litbor, livbor,
     &    dataval, ikle_bnd, elelg, typ_elem, time, title, nvar,
     &    ntimestep, nptfr, npoin2, nparts, npoin, nout, ndp, f,
     &    variable, typ_bnd_elem, nptir_p, nameinp, namecli,
     &    color)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |<--| Format of the result file
!| NBOR           |<--| Boundary file numbering
!| KNOGL          |<--| Global to local numbering
!| NDP_BND        |<--| Number of points for a boundary element
!| NELEBD         |<--| Number of boundary elements
!| NINP           |<--| Input file descriptor
!| NPLAN          |<--| Number of planes
!| IKLES          |<--| Connectivity table
!| TIMES          |<--| List of times in the file
!| KNOLG          |<--| Local to global numbering
!| DATE           |<--| Date of the file
!| NELEM_P        |<--| Number of elements in partitionned file
!| NPOIN_P        |<--| Number of points in partitionned file
!| NPTFR_P        |<--| Number of boundary points in partitionned file
!| UBOR           |<--| U velocity on boundary points
!| HBOR           |<--| Heigh on boundary points
!| TBOR           |<--| Tracer values on boundary points
!| VBOR           |<--| V velocity on boundary points
!| BTBOR          |<--| Second thermal exchange coeff
!| ATBOR          |<--| First thermal exchange coeff
!| LIUBOR         |<--| Type of boundary for U
!| LIHBOR         |<--| Type of boundary for H
!| LITBOR         |<--| Type of boundary for Tracers
!| LIVBOR         |<--| Type of boundary for V
!| DATAVAL        |<--| Results array
!| IKLE_BND       |<--| Connectivity array for boundary elements
!| ELELG          |<--| Local to global numbering for elements
!| TYP_ELEM       |<--| Type of the elements (TRIANGLE, ...)
!| TIME           |<--| Time of the file
!| TITLE          |<--| Title fo the output file
!| NVAR           |<--| Number fo variables
!| NTIMESTEP      |<--| Number of time-steps
!| NPTFR          |<--| Number of boundary_points
!| NPOIN2         |<--| Number of 2D points
!| NPARTS         |<--| Number of partitions
!| NPOIN          |<--| Number of points
!| NOUT           |<--| Output file descriptor
!| NDP            |<--| Number of points per element
!| F              |<--| Coordinates
!| VARIABLE       |<--| List of variable names
!| TYP_BND_ELEM   |<--| Type of boundary elements
!| NPTIR_P        |<--| Number of Interface points in partitionned file
!| NAMEINP        |<--| Name of input file
!| NAMECLI        |<--| Name of boundary file
!| COLOR          |<--| Colour for each boundary point
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE declarations_special
        USE declarations_partel
        USE interface_hermes
        USE mod_hash_table
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER, ALLOCATABLE, INTENT(INOUT) :: NBOR(:)
!
        DOUBLE PRECISION, ALLOCATABLE, INTENT(IN) :: DATAVAL(:,:,:)
        DOUBLE PRECISION, ALLOCATABLE, INTENT(IN) :: F(:,:)
        TYPE(hash_table), INTENT(IN) :: KNOGL
        CHARACTER(LEN=8), INTENT(INOUT) :: FFORMAT
        CHARACTER(LEN=80), INTENT(IN) :: TITLE
        CHARACTER(LEN=32), ALLOCATABLE, INTENT(IN) :: VARIABLE(:)
        CHARACTER(LEN=PATH_LEN), INTENT(IN) :: NAMEINP, NAMECLI
        INTEGER, INTENT(IN) :: NDP_BND, NELEBD, NINP, NPLAN, TIME(3),
     &   typ_bnd_elem, date(3), typ_elem, nvar, ntimestep, nptfr,
     &   npoin2, nparts, npoin, ndp
        INTEGER, INTENT(INOUT) :: NOUT
        INTEGER, ALLOCATABLE, INTENT(IN) :: IKLES(:), KNOLG(:,:),
     &    nelem_p(:), npoin_p(:), nptfr_p(:), liubor(:), lihbor(:),
     &    litbor(:), livbor(:), ikle_bnd(:), elelg(:,:), nptir_p(:),
     &    color(:)
        DOUBLE PRECISION, INTENT(INOUT) :: TIMES
        DOUBLE PRECISION, ALLOCATABLE, INTENT(IN) :: HBOR(:),UBOR(:),
     &    vbor(:), chbord(:), tbor(:),atbor(:),btbor(:)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER :: I, J, K, L, M, IERR, ITIME, EF, IVAR, NELEBD_P
        INTEGER :: IPTFR, IPTFR_P
        INTEGER, ALLOCATABLE :: IKLE_BND_P(:)
        INTEGER, ALLOCATABLE :: KNOLG_P(:), IKLE_P(:), IKLE3D_P(:)
        DOUBLE PRECISION, ALLOCATABLE :: HBOR_P(:),UBOR_P(:),VBOR_P(:)
        DOUBLE PRECISION, ALLOCATABLE :: TBOR_P(:),ATBOR_P(:)
        DOUBLE PRECISION, ALLOCATABLE :: BTBOR_P(:), DATAVAL_P(:)
        DOUBLE PRECISION, ALLOCATABLE :: CHBORD_P(:), X(:), Y(:)
        INTEGER, ALLOCATABLE :: LIVBOR_P(:),LITBOR_P(:),COLOR_P(:)
        INTEGER, ALLOCATABLE :: LIHBOR_P(:),LIUBOR_P(:),NBOR_P(:)
        INTEGER, ALLOCATABLE :: KNOGL_BND(:)
        LOGICAL FULLY_IN
        CHARACTER(LEN=PATH_LEN) :: NAMEOUT, NAMECLM
        CHARACTER(LEN=11) :: EXTENS
        EXTERNAL extens
!
        DO i=1,nparts
!
          WRITE(lu,*) 'TREATING SUB-DOMAIN ', i
!
!         WRITING GEOMETRY FILES FOR ALL PARTS/PROCESSORS
!
          IF(partel_concat)THEN
            nameout = trim(nameinp)//'-CONCAT'
            nameclm = trim(namecli)//'-CONCAT'
            CALL open_mesh(fformat,nameout,nout,'WRITE    ',ierr, i)
          ELSE
            nameout = trim(nameinp)//extens(nparts-1,i-1)
            nameclm = trim(namecli)//extens(nparts-1,i-1)
            CALL open_mesh(fformat,nameout,nout,'WRITE    ',ierr)
          ENDIF
          CALL check_call(ierr,'PARTEL:OPEN_MESH:NOUT')
!
!         TITLE, THE NUMBER OF VARIABLES
!
          CALL set_header(fformat,nout,title,nvar,variable,ierr)
!
!       THE MESH
!
          ALLOCATE(ikle_p(nelem_p(i)*3),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:IKLE_P')
          DO j=1,nelem_p(i)
            ef=elelg(j,i)
            DO k=1,3
              ikle_p(j+(k-1)*nelem_p(i)) =
     &          hash_table_get(knogl,ikles((ef-1)*3+k),i)
            ENDDO
          ENDDO
          IF(nplan.GT.1) THEN
            ALLOCATE(ikle3d_p(nelem_p(i)*6*(nplan-1)),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:IKLE_P')
            DO k = 1,nplan-1
              DO j = 1,nelem_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (0*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (0*nelem_p(i))) + (k-1)*npoin_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (1*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (1*nelem_p(i))) + (k-1)*npoin_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (2*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (2*nelem_p(i))) + (k-1)*npoin_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (3*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (0*nelem_p(i))) + (k)*npoin_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (4*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (1*nelem_p(i))) + (k)*npoin_p(i)
                ikle3d_p(j+(k-1)*nelem_p(i) + (5*nelem_p(i)*(nplan-1)))=
     &       ikle_p(j + (2*nelem_p(i))) + (k)*npoin_p(i)
              ENDDO
            ENDDO
          ENDIF
!
! INSTEAD OF IRAND, KNOLG IS WRITTEN !!!
! I.E. THE TABLE PROCESSOR-LOCAL -> PROCESSOR-GLOBAL NODE NUMBERS
!
          IF(nplan.EQ.0) THEN
            ALLOCATE(knolg_p(npoin_p(i)),stat=ierr)
            CALL check_call(ierr,'PARTEL:KNOLG_P:2D')
            DO j=1,npoin_p(i)
              knolg_p(j) = knolg(j,i)
            ENDDO
          ELSE
            ALLOCATE(knolg_p(npoin_p(i)*nplan),stat=ierr)
            CALL check_call(ierr,'PARTEL:KNOLG_P:3D')
            DO j=1,npoin_p(i)*nplan
              ! WE FILL KNOLG WITH DUMMY VALUES BECAUSE 3D KNOLG IS NEVER USED
              knolg_p(j) = knolg(j,i)
            ENDDO
          ENDIF
!
! NODE COORDINATES X AND Y
!
          IF(nplan.EQ.0) THEN
            ALLOCATE(x(npoin_p(i)),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:X')
            ALLOCATE(y(npoin_p(i)),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:Y')
            DO j=1,npoin_p(i)
              x(j) = f(knolg(j,i),1)
              y(j) = f(knolg(j,i),2)
            ENDDO
          ELSE
            ALLOCATE(x(npoin_p(i)*nplan),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:X')
            ALLOCATE(y(npoin_p(i)*nplan),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:Y')
            DO j=1,npoin_p(i)
              DO l=1,nplan
                x(j+(l-1)*nplan) = f(knolg(j,i)+(l-1)*npoin2,1)
                y(j+(l-1)*nplan) = f(knolg(j,i)+(l-1)*npoin2,2)
              ENDDO
            ENDDO
          ENDIF
          IF(nplan.EQ.0) THEN
            CALL set_mesh(fformat,nout,2,typ_elem,ndp,nptfr_p(i),
     &                    nptir_p(i),nelem_p(i),npoin_p(i),ikle_p,
     &                    knolg_p,knolg_p,x,y,nplan,date,time,
     &                    x_orig,y_orig,
     &                    ierr)
            CALL check_call(ierr,'PARTEL:SET_MESH:NOUT')
          ELSE
            CALL set_mesh(fformat,nout,3,typ_elem,6,nptfr_p(i),
     &                    nptir_p(i),nelem_p(i)*(nplan-1),
     &                    npoin_p(i)*nplan,ikle3d_p,
     &                    knolg_p,knolg_p,x,y,nplan,date,time,
     &                    x_orig,y_orig,
     &                    ierr)
            CALL check_call(ierr,'PARTEL:SET_MESH:NOUT')
            DEALLOCATE(ikle3d_p)
          ENDIF
          DEALLOCATE(x)
          DEALLOCATE(y)
          DEALLOCATE(knolg_p)
          DEALLOCATE(ikle_p)
!
!         WORK ON THE BOUNDARY CONDITIONS INFORMATIONS
!
          ! COMPUTE THE NUMBER OF BOUNDARY_ELEMENTS
          nelebd_p = 0
          DO k=1,nelebd
            fully_in = .true.
            DO l=1,ndp_bnd
            ! IF EVERY POINT OF THE BOUNDARY ELEMENT IS IN THE PARTITION THEN THE ELEMENT IS AS WELL
              IF(hash_table_get(knogl,
     &            ikle_bnd(k+(l-1)*nelebd),i).EQ.0)THEN
                fully_in = .false.
                EXIT
              ENDIF
            ENDDO
            ! IF
            IF(fully_in) nelebd_p = nelebd_p + 1
          ENDDO
!
          ! WRITING THE BOUNDARY CONDITIONS
          IF(partel_concat)THEN
            CALL open_bnd(fformat,nameclm,nout,'WRITE    ',ierr,i)
          ELSE
            CALL open_bnd(fformat,nameclm,nout,'WRITE    ',ierr)
          ENDIF
          CALL check_call(ierr,'PARTEL:OPEN_BND')
          !
          ALLOCATE(ikle_bnd_p(nelebd_p*ndp_bnd),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:IKLE_BND_P')
          ALLOCATE(lihbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:LIHBOR_P')
          ALLOCATE(liubor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:LIUBOR_P')
          ALLOCATE(livbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:LIVBOR_P')
          ALLOCATE(hbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:HBOR_P')
          ALLOCATE(ubor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:UBOR_P')
          ALLOCATE(vbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:VBOR_P')
          ALLOCATE(chbord_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:CHBORD_P')
          ALLOCATE(litbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:LITBOR_P')
          ALLOCATE(tbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:TBOR_P')
          ALLOCATE(atbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:ATBOR_P')
          ALLOCATE(btbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:BTBOR_P')
          ALLOCATE(knogl_bnd(nelebd),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:KNOGL_BND')
          ALLOCATE(color_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:COLOR')
          ALLOCATE(nbor_p(nptfr_p(i)),stat=ierr)
          CALL check_allocate(ierr,'PARTEL:NBOR')
          j = 0
          DO k=1,nelebd
            knogl_bnd(k) = 0
            ! IF BOTH POINT OF THE SEGMENT ARE IN THE PARTITION THEN THE SEGMENT IS IN THE PARTITION
            fully_in = .true.
            DO l=1,ndp_bnd
              IF(hash_table_get(knogl,
     &            ikle_bnd(k+(l-1)*nelebd),i).EQ.0) THEN
                fully_in = .false.
                EXIT
              ENDIF
            ENDDO
            IF(fully_in) THEN
              j = j + 1
              DO l=1,ndp_bnd
                m = ikle_bnd(k+(l-1)*nelebd)
                ikle_bnd_p(j+(l-1)*nelebd_p) = hash_table_get(knogl,m,i)
              ENDDO
              knogl_bnd(k) = j
            ENDIF
          ENDDO
!
          iptfr_p = 0
          DO iptfr=1,nptfr
            IF(hash_table_get(knogl,nbor(iptfr),i).EQ.0) cycle
            iptfr_p = iptfr_p + 1
            nbor_p(iptfr_p) = hash_table_get(knogl,nbor(iptfr),i)
            hbor_p(iptfr_p) = hbor(iptfr)
            ubor_p(iptfr_p) = ubor(iptfr)
            vbor_p(iptfr_p) = vbor(iptfr)
            chbord_p(iptfr_p) = chbord(iptfr)
            tbor_p(iptfr_p) = tbor(iptfr)
            atbor_p(iptfr_p) = atbor(iptfr)
            btbor_p(iptfr_p) = btbor(iptfr)
            lihbor_p(iptfr_p) = lihbor(iptfr)
            liubor_p(iptfr_p) = liubor(iptfr)
            livbor_p(iptfr_p) = livbor(iptfr)
            litbor_p(iptfr_p) = litbor(iptfr)
            color_p(iptfr_p) = color(iptfr)
          ENDDO
          ! Transfering group information from geometry to result file
          CALL transfer_group_part_info(fformat,ninp,nout,
     &             typ_bnd_elem, ikle_bnd_p, nelebd_p, ndp_bnd,
     &             nelebd, knogl_bnd, .true., npoin, npoin_p(i),
     &             knolg(:,i), ierr)
          CALL check_call(ierr,'PARTEL:TRANSFER_GROUP_PART_INFO')

          CALL set_bnd(fformat,nout,point_bnd_elt_type,nptfr_p(i),1,
     &                 nbor_p,nptfr_p(i),lihbor_p,liubor_p,
     &                 livbor_p,hbor_p,ubor_p,vbor_p,chbord_p,
     &                 litbor_p,tbor_p,atbor_p,btbor_p,
     &                 color_p,ierr)
          CALL check_call(ierr,'PARTEL:SET_BND')
          !

          IF(partel_concat)THEN
            CALL close_bnd(fformat,nout,ierr,i)
          ELSE
            CALL close_bnd(fformat,nout,ierr)
          ENDIF
          CALL check_call(ierr,'PARTEL:CLOSE_BND')

          DEALLOCATE(ikle_bnd_p)
          DEALLOCATE(lihbor_p)
          DEALLOCATE(liubor_p)
          DEALLOCATE(livbor_p)
          DEALLOCATE(hbor_p)
          DEALLOCATE(ubor_p)
          DEALLOCATE(vbor_p)
          DEALLOCATE(chbord_p)
          DEALLOCATE(litbor_p)
          DEALLOCATE(tbor_p)
          DEALLOCATE(atbor_p)
          DEALLOCATE(btbor_p)
          DEALLOCATE(color_p)
          DEALLOCATE(nbor_p)
          DEALLOCATE(knogl_bnd)
!
! TIME STAMP (SECONDS)
!
!!
!!   -------------------------------------------------------------------
!!   MODIFICATION TO PUT ALL THE RECORDINGS IN PARALLEL
!!   GEO FILE 08/06/2011
!!   -------------------------------------------------------------------
!!
!         EACH RECORDING IS READ AND ONLY THE LOCAL VARIABLES ARE STORED
!         INTO THE PARALLEL GEO FILE
!
!
          IF(nplan.LE.1) THEN
            ALLOCATE(dataval_p(npoin_p(i)),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:DATAVAL_P')
          ELSE
            ALLOCATE(dataval_p(npoin_p(i)*nplan),stat=ierr)
            CALL check_allocate(ierr,'PARTEL:DATAVAL_P')
          ENDIF
          DO itime=1,ntimestep
            CALL get_data_time(fformat,ninp,itime-1,times,ierr)
            CALL check_call(ierr,'PARTEL:GET_DATA_TIME:NINP')
            WRITE(lu,*) ' -- WRITING TIMESTEP',itime-1,' AT',REAL(times)
            DO ivar=1,nvar
              IF(nplan.EQ.0) THEN
                ! 2D
                DO j=1,npoin_p(i)
                  dataval_p(j) = dataval(knolg(j,i),ivar,itime)
                ENDDO
                CALL add_data(fformat,nout,variable(ivar),times,itime-1,
     &                        ivar.EQ.1,dataval_p,npoin_p(i),ierr)
                CALL check_call(ierr,'PARTEL:ADD_DATA')
              ELSE
                ! 3D
                DO j=1,npoin_p(i)
                  DO l=1,nplan
                    dataval_p(j + (l-1)*npoin_p(i)) =
     &                       dataval(knolg(j,i)+(l-1)*npoin2,ivar,itime)
                  ENDDO
                ENDDO
                CALL add_data(fformat,nout,variable(ivar),times,itime-1,
     &                        ivar.EQ.1,dataval_p,npoin_p(i)*nplan,ierr)
                CALL check_call(ierr,'PARTEL:ADD_DATA')
              ENDIF
            ENDDO
          ENDDO
          DEALLOCATE(dataval_p)
          IF(partel_concat)THEN
            CALL close_mesh(fformat,nout,ierr,i)
          ELSE
            CALL close_mesh(fformat,nout,ierr)
          ENDIF
          CALL check_call(ierr,'PARTEL:CLOSE_MESH:NOUT')
        ENDDO
        CALL close_bnd(fformat,ninp,ierr)
        CALL check_call(ierr,'PARTEL:CLOSE_BND:NCLI')
        CALL close_mesh(fformat,ninp,ierr)
        CALL check_call(ierr,'PARTEL:CLOSE_MESH:NINP')
      END SUBROUTINE
      END MODULE mod_write_solutions