st_qaprint_dfs_lasers.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_dfs_lasers (xlas, ilas)

Function/Subroutine Documentation

st_qaprint_dfs_lasers()

subroutine st_qaprint_dfs_lasers	(	dimension(*), intent(in)	xlas,
		integer, dimension(*), intent(in)	ilas )

Definition at line 30 of file st_qaprint_dfs_lasers.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE qa_out_mod
        USE groupdef_mod
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real, INTENT(IN) :: xlas(*)
      INTEGER, INTENT(IN) :: ILAS(*)    
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: OK_QA
      CHARACTER (LEN=255) :: VARNAME
      INTEGER K,J,DET_IID,I1,I2,I3,I4,I5,I6
      DOUBLE PRECISION TEMP_DOUBLE      
      INTEGER :: NL,K1,K2,IFUNC,ITYP, IFK, MFK, IAFUNC, NCELL
      DOUBLE PRECISION :: CHALEUR, FSI, XK0, HNUK, DAR_HNUK_2,ONE_TIMESCAL, FI, ALPHA
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
      IF (myqakey('LASERS') ) THEN 
 
        k1 = 1
        k2 = 1
      
        DO k=1,nlaser
 
          nl            = ilas(k1)  
          ifunc         = ilas(k1+3) 
          iafunc        = ilas(k1+4) 
          ityp          = ilas(k1+5) 
 
          chaleur       = xlas(k2)   
          fi            = xlas(k2+1) 
          alpha         = xlas(k2+2) 
 
          xk0           = xlas(k2+3) 
          hnuk          = xlas(k2+4) 
          dar_hnuk_2    = xlas(k2+5) 
          one_timescal   = xlas(k2+6) 
 
                           
          WRITE(varname,'(A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1,')=NL :'                  
          CALL qaprint(varname(1:len_trim(varname)),ilas(k1),0.0_8)                        
          WRITE(varname,'(A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1+3,')=IFUNC :'               
          CALL qaprint(varname(1:len_trim(varname)),ilas(k1+3),0.0_8)                      
          WRITE(varname,'(A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1+4,')=IAFUNC :'              
          CALL qaprint(varname(1:len_trim(varname)),ilas(k1+4),0.0_8)                      
          WRITE(varname,'(A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1+5,')=ITYP :'                
          CALL qaprint(varname(1:len_trim(varname)),ilas(k1+5),0.0_8)                      
 
          ncell=0
          DO j=1,2*nl,2   
            ncell=ncell+1                                                                 
            WRITE(varname,'(A,I0,A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1+5+j,')=ELEM(',ncell,') :'              
            CALL qaprint(varname(1:len_trim(varname)),ilas(k1+5+j),0.0_8)                  
            WRITE(varname,'(A,I0,A,I0,A)') 'LASER(',k ,')%ILAS(',k1+5+j+1,')=NG :'                
            CALL qaprint(varname(1:len_trim(varname)),ilas(k1+5+j+1),0.0_8)                
          ENDDO                                                                            
 
          WRITE(varname,'(A,I0,A,I0,A,I0,A)') 'LASER(',k ,')%XLAS(',k2,')=CHALEUR :'       
          CALL qaprint(varname(1:len_trim(varname)),0,chaleur)                             
          WRITE(varname,'(A,I0,A,I0,A,I0,A)') 'laser(',K ,')%XLAS(',K2+1,')=fi :'            
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,FI)                                  
          WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+2,')=alpha :'         
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,ALPHA)                               
 
          WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+3,')=xk0 :'           
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,XK0)                                 
          WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+4,')=hnuk :'          
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,HNUK)                                
          WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+5,')=dar_hnuk_2 :'    
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,DAR_HNUK_2)                          
          WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+6,')=un_timescal :'   
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,ONE_TIMESCAL)                         
 
          IFK = 6 + 2*(NL+1)  
          MFK = 7             
          K1 = K1 + IFK       
          K2 = K2 + MFK       
                                                                         
        ENDDO !next K                                                                   
      ENDIF                
C-----------------------------------------------
      RETURN