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)
 1800   FORMAT(i10)
 1900   FORMAT('   ',a100)
C-----------
 
        RETURN