r2r_input.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_input (iexter)

Function/Subroutine Documentation

r2r_input()

subroutine r2r_input

(

integer, dimension(nr2r,*)

iexter

)

Definition at line 32 of file r2r_input.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE r2r_mod
        USE inoutfile_mod
        USE reader_old_mod , ONLY : nslash
        USE reader_old_mod , ONLY : kr2r
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IEXTER(NR2R,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER REF,I,J,S,START,ADDRESS(NSUBDOM+1),NB(NSUBDOM+1)
        INTEGER COMPT,TAB_TMP((NSUBDOM+1)*NR2RLNK),IDOM,TLK
        CHARACTER NAME_FULL*150,NAM*150,NAM_TMP*150,LINKZ*80,CHRUN*4
        INTEGER :: LEN_TMP_NAME
        CHARACTER(len=4096) :: TMP_NAME
C-----------------------------------------------
 
        ref = 1981
        tab_tmp(:)=0
 
C-----Creation of arrays for Links---
 
        compt = 1
        start = nslash(kr2r)+1
 
        DO i=0,nsubdom
          address(i+1)=compt
          DO j=start,nr2rlnk
            IF ((iexter(3,j)==i).OR.(iexter(4,j)==i)) THEN
              tab_tmp(compt)=iexter(2,j)
              compt = compt+1
            ENDIF
          END DO
          nb(i+1)=compt-address(i+1)
        END DO
 
C-------------------------------------
 
        WRITE(chrun,'(I4.4)')irun
        ! *r2r is an input file for the engine
        nam = rootnam0(1:len_trim(rootnam0))//'_'//chrun//'.r2r'
        tmp_name=infile_name(1:infile_name_len)//nam(1:len_trim(nam))
        len_tmp_name = infile_name_len+len_trim(nam)
 
        OPEN(unit=ref,file=tmp_name(1:len_tmp_name),
     .        access='SEQUENTIAL',form='FORMATTED',status='UNKNOWN')
 
        WRITE(ref,1000)'--------------------------------------------'
        WRITE(REF,1000)' rad2rad input file - generated by starter  '
        WRITE(REF,1000)'--------------------------------------------'
        WRITE(REF,1400)'$         '
 
C-----Generation of domains input cards--------
 
        WRITE(REF,1000)'--------------------------------------------'
        WRITE(REF,1000)' 1. domains                                 '
        WRITE(REF,1000)'--------------------------------------------'
        NAME_FULL=ROOTNAM0(1:LEN_TRIM(ROOTNAM0))
        WRITE(REF,1100) NAME_FULL
 
        DO I=1,NSUBDOM+1
          IF ((I-1)/=0) THEN
            NAM=DOM_NAME(ISUBDOM(8,I-1):ISUBDOM(8,I-1)+ISUBDOM(7,I-1)-1)
            WRITE(REF,1100) NAM
          ENDIF
          WRITE(REF,1500) (TAB_TMP(J+ADDRESS(I)-1),J=1,NB(I))
        END DO
 
C-----Generation of interfaces input cards -----
 
        WRITE(REF,1000)'--------------------------------------------'
        WRITE(REF,1000)' 2. interfaces                              '
        WRITE(REF,1000)'--------------------------------------------'
 
        DO I=START,NR2RLNK
          IF (IEXTER(5,I)==40) THEN
C--->  type = 40 -> interface for main nodes of RBODY -----
            WRITE(REF,1310) IEXTER(5,I)/10
          ELSEIF (IEXTER(5,I)==50) THEN
C--->  type = 50 -> interface type KINE----------------- -----
            WRITE(REF,1330) IEXTER(5,I)/10
          ELSEIF (IEXTER(5,I)==60) THEN
C--->  type = 60 -> interface type FSI------------------ -----
            TLK = 4
            IF (FLG_TIED(5)==1) THEN
              WRITE(REF,1350) TLK
            ELSE
              WRITE(REF,1340) TLK
            ENDIF
            WRITE(REF,*) ' 0.1'
          ELSEIF (IEXTER(5,I)==70) THEN
C--->  type = 70 -> interface type NLOCAL--------------- -----
            TLK = 4
            WRITE(REF,1360) TLK
          ELSEIF (FLG_TIED(IEXTER(5,I))==1) THEN
            WRITE(REF,1320) IEXTER(5,I)
          ELSE
            WRITE(REF,1300) IEXTER(5,I)
          ENDIF
          WRITE(LINKZ,1800) IEXTER(2,I)
C--------
          DO J=1,2
            IF (IEXTER(2+J,I)==0) THEN
              NAM_TMP = NAME_FULL
            ELSE
              IDOM = IEXTER(2+J,I)
              S = ISUBDOM(8,IDOM)
              NAM_TMP = DOM_NAME(S:S+ISUBDOM(7,IDOM)-1)
            ENDIF
            NAM=TRIM(NAM_TMP)//'  '//TRIM(LINKZ)
            WRITE(REF,1900) NAM
          END DO
C--------
        END DO
 
C-----Generation of options input cards--------
 
        WRITE(REF,1000)'--------------------------------------------'
        WRITE(REF,1000)' 3. options                                 '
        WRITE(REF,1000)'--------------------------------------------'
 
        WRITE(REF,1400)'/siff     '
        WRITE(REF,1400)'/mltps/on '
        WRITE(REF,1400)'$         '
        WRITE(REF,1400)'/END      '
        CLOSE(REF)
 
C--------------------------------------------------------------C
        RETURN
 
 1000   FORMAT('$',A44)
 1100   FORMAT('/DOMAIN/',A100)
 1300   FORMAT('/LINK/TYPE',I1)
 1310   FORMAT('/LINK/TYPE',I1,'/RBODY')
 1320   FORMAT('/LINK/TYPE',I1,'/TIED')
 1330   FORMAT('/LINK/TYPE',I1,'/KINE')
 1340   FORMAT('/LINK/TYPE',i1,'/FSI')
 1350   FORMAT('/LINK/TYPE',i1,'/TIED/FSI')
 1360   FORMAT('/LINK/TYPE',i1,'/NLOCAL')
 1400   FORMAT('',a10)
 1500   FORMAT(  3x,10i5)
 1600   FORMAT('   ',a10,i10)
 1700   FORMAT('   SUBDOMAIN',i1,i10)
 1800   FORMAT(i10)
 1900   FORMAT('   ',a100)
C-----------
 
        RETURN