OUTPUT
NAME
INPUT
DESCRIPTION
Package output :
m_qtlmap_output_handler
[ Top ] [ OUTPUT ] [ Modules ]
NAME
m_qtlmap_output_handler -- Print analysisresult information on a ASCII format
SYNOPSIS
DESCRIPTION
NOTES
SEE ALSO
create_grid_file_2QTL
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
create_grid_file_2QTL
DESCRIPTION
NOTE A MODIFIER print_summary_analyse pour prendre en compte les effets d interaction QTL
SOURCE
1492 subroutine create_grid_file_2QTL(lrtsol) 1493 type(TYPE_LRT_SOLUTION) , intent(in) :: lrtsol 1494 1495 integer :: n,n1,nout2,chr,chr2,ios 1496 character(len=100) :: FMT1,FMT2 1497 1498 if ( trim(grid2qtl) == '' ) then 1499 return 1500 end if 1501 1502 nout2=17 1503 open(UNIT=nout2,file=grid2qtl, form="formatted",recl=BUF_ALLOC_FILE,iostat=ios) 1504 if (ios/=0) then 1505 call stop_application("Can not open the file :"//trim(grid2qtl)) 1506 end if 1507 1508 1509 FMT1="(6x,"//trim(str(get_maxnpo()))//"(2x,f4.2,2x))" 1510 FMT2="(1x,f4.2,1x,"//trim(str(get_maxnpo()))//"(f7.2,1x))" 1511 1512 ! 1513 ! Cr�ation d'un fichier grid_qtl pour ue representation graphique 1514 ! 1515 1516 write(nout2,*) 1517 write(nout2,*) '++++++++++++++++ TEST 1QTL / 2QTL ++++++++++++++++++++' 1518 write(nout2,*) 1519 write(nout2,FMT=FMT1) ((absi(chr,n),n=1,get_npo(chr)),chr=1,nchr) 1520 do chr=1,nchr 1521 do n=1,get_npo(chr) 1522 write(nout2,FMT=FMT2) absi(chr,n),((lrtsol%lrt1_2(chr,chr2,n,n1),n1=1,get_npo(chr2)),chr2=1,nchr) 1523 end do 1524 end do 1525 1526 write(nout2,*) 1527 write(nout2,*) ' +++++++++++++++++ TEST 0QTL / 2QTL ++++++++++++++++++++' 1528 write(nout2,*) 1529 1530 write(nout2,FMT=FMT1)((absi(chr,n),n=1,get_npo(chr)),chr=1,nchr) 1531 do chr=1,nchr 1532 do n=1,get_npo(chr) 1533 write(nout2,FMT=FMT2) absi(chr,n),((lrtsol%lrt0_2(chr,chr2,n,n1),n1=1,get_npo(chr2)),chr2=1,nchr) 1534 end do 1535 end do 1536 1537 close(nout2) 1538 end subroutine
end_output_handler
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
end_output_handler
DESCRIPTION
SOURCE
238 subroutine end_output_handler(opt_qtl) 239 integer, intent(in) :: opt_qtl 240 character(8) :: date 241 character(10) :: time 242 243 if ( trim(resp)/='' ) close(unit_sire_res) 244 if ( trim(resm)/='' ) close(unit_dam_res) 245 close(unit_summary) 246 if (opt_qtl == 2) then 247 close(unit_summary_2qtl) 248 end if 249 250 if ( trim(pateff)/='' ) close(unit_paternal_effects) 251 if ( trim(mateff)/='' ) close(unit_maternal_effects) 252 253 if ( trim(out_phases)/='' ) close(unit_phases) 254 if ( trim(out_haplotypes)/='' ) close(unit_haplotypes) 255 if ( trim(out_freqall)/='' ) close(unit_freqall) 256 257 call date_and_time(DATE=date,TIME=time) 258 259 write (nficout,*) ' *** ' 260 write (nficout,*) ' DATE = ',date(1:4),'/',date(5:6),'/',date(7:8),'-',time(1:2),':',time(3:4),':',time(5:6) 261 write (nficout,*) ' *** ' 262 close(nficout) 263 264 end subroutine end_output_handler
init_output_handler
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
init_output_handler
DESCRIPTION
SOURCE
131 subroutine init_output_handler(opt_qtl,opt_calcul,name_funct,nb_thread) 132 integer, intent(in) :: opt_qtl,opt_calcul,nb_thread 133 character(len=300) , intent(in) :: name_funct 134 integer :: ios 135 integer :: val_recl = BUF_ALLOC_FILE ! anciennement 2048 136 character(8) :: date 137 character(10) :: time 138 139 140 ios=0 141 open(UNIT=nficout,file=resul, form="formatted",recl=val_recl,iostat=ios) 142 if (ios/=0) then 143 call stop_application("Can not open the file :"//trim(resul)) 144 end if 145 146 call date_and_time(DATE=date,TIME=time) 147 148 write (nficout,*) ' *** ' 149 write (nficout,*) ' DATE = ',date(1:4),'/',date(5:6),'/',date(7:8),'-',time(1:2),':',time(3:4),':',time(5:6) 150 write (nficout,*) ' --QTL = ',opt_qtl 151 write (nficout,*) ' --CALCUL = ',opt_calcul,' (',trim(name_funct),')' 152 write (nficout,*) 'OMP_NUM_THREADS = ',nb_thread 153 154 open(UNIT=unit_summary,file=summary, form="formatted",recl=val_recl,iostat=ios) 155 if (ios/=0) then 156 call stop_application("Can not open the file :"//trim(summary)) 157 end if 158 159 if ( trim(resp)/='' ) then 160 open(UNIT=unit_sire_res,file=resp, form="formatted",recl=val_recl,iostat=ios) 161 if (ios/=0) then 162 call stop_application("Can not open the file :"//trim(resp)) 163 end if 164 end if 165 166 if ( trim(resm)/='' ) then 167 open(UNIT=unit_dam_res,file=resm, form="formatted",recl=val_recl,iostat=ios) 168 if (ios/=0) then 169 call stop_application("Can not open the file :"//trim(resm)) 170 end if 171 end if 172 173 if ( trim(pateff)/='' ) then 174 open(UNIT=unit_paternal_effects,file=pateff,form="formatted",recl=val_recl,iostat=ios) 175 if (ios/=0) then 176 call stop_application("Can not open the file :"//trim(pateff)) 177 end if 178 179 write(unit_paternal_effects,*) ' ********************************************* ' 180 write(unit_paternal_effects,*) ' This file is unvalide if interaction qtl case ' 181 write(unit_paternal_effects,*) ' ********************************************* ' 182 183 end if 184 185 if ( trim(mateff)/='' ) then 186 open(UNIT=unit_maternal_effects,file=mateff,form="formatted",recl=val_recl,iostat=ios) 187 if (ios/=0) then 188 call stop_application("Can not open the file :"//trim(mateff)) 189 end if 190 191 write(unit_maternal_effects,*) ' ********************************************* ' 192 write(unit_maternal_effects,*) ' This file is unvalide if interaction qtl case ' 193 write(unit_maternal_effects,*) ' ********************************************* ' 194 end if 195 196 if ( trim(out_phases)=='' ) then 197 out_phases = trim(resul)//'_phases' 198 end if 199 200 open(UNIT=unit_phases,file=out_phases,form="formatted",recl=val_recl,iostat=ios) 201 if (ios/=0) then 202 call stop_application("Can not open the file :"//trim(out_phases)) 203 end if 204 205 if ( trim(out_freqall)=='' ) then 206 out_freqall = trim(resul)//'_freqall' 207 end if 208 209 open(UNIT=unit_freqall,file=out_freqall,form="formatted",recl=val_recl,iostat=ios) 210 if (ios/=0) then 211 call stop_application("Can not open the file :"//trim(out_freqall)) 212 end if 213 214 if ( trim(out_haplotypes)/='' ) then 215 open(UNIT=unit_haplotypes,file=out_haplotypes,form="formatted",recl=val_recl,iostat=ios) 216 if (ios/=0) then 217 call stop_application("Can not open the file :"//trim(out_haplotypes)) 218 end if 219 end if 220 221 if (opt_qtl == 2) then 222 sum_2qtl=trim(summary)//'2qtl' 223 open(UNIT=unit_summary_2qtl,file=sum_2qtl, form="formatted",recl=val_recl,iostat=ios) 224 if (ios/=0) then 225 call stop_application("Can not open the file :"//trim(sum_2qtl)) 226 end if 227 228 end if 229 end subroutine init_output_handler
log_descriptif_genealogy
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
log_descriptif_genealogy
DESCRIPTION
SOURCE
323 subroutine log_descriptif_genealogy(file_gena) 324 character(len=LENGTH_MAX_FILE) , intent(in) :: file_gena 325 integer :: ip,ir,im 326 327 character(len=LEN_DEF) :: unknown_r 328 329 write(nficout,FMT='(/,/,5x,' // & 330 '"***************** GENEALOGY DESCRIPTION *****************",/)') 331 332 333 write (nficout,FMT='(1x,"The pedigree file includes ",i3," parents",' // & 334 '" born from",i3," grand sires and ",i3," grand dams")') & 335 size(repro),size(gpere),size(gmere) 336 337 write(nficout,FMT='(1x,"and ",i4," progeny born from",' // & 338 'i3," sires and ",i3," dams")')size(animal),size(pere),size(mere) 339 340 unknown_r='' 341 do ip=1,size(pere) 342 do ir=1,size(repro) 343 if(pere(ip) == repro(ir)) then 344 exit 345 endif 346 end do 347 if (ir > size(repro) ) then 348 unknown_r = unknown_r//' '//trim(pere(ip)) 349 end if 350 end do 351 if (unknown_r /= '' ) then 352 write(nficout,FMT='(1x,"Sires",a10," have no known ancestor")') trim(unknown_r) 353 end if 354 355 unknown_r='' 356 do im=1,size(mere) 357 do ir=1,size(repro) 358 if(mere(im) == repro(ir)) then 359 exit 360 endif 361 end do 362 if (ir > size(repro) ) then 363 unknown_r = unknown_r//' '//trim(mere(im)) 364 end if 365 end do 366 367 if (unknown_r /= '' ) then 368 write(nficout,FMT='(1x,"Dams ",a10," have no known ancestor")') trim(unknown_r) 369 end if 370 371 end subroutine log_descriptif_genealogy
log_descriptif_traits
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
log_descriptif_traits
DESCRIPTION
SOURCE
487 subroutine log_descriptif_traits() 488 integer :: ngeno,kd,ic,ifx,ilev,ico,alloc_stat 489 integer :: iperf,i,nnn,jfx,l 490 real (kind=dp) :: sy,sy2 491 real (kind=dp), dimension (:), allocatable :: covmu,covsig,covmin,covmax,ymax,ymin 492 integer, dimension (:), allocatable :: ncens,nmanq 493 character(len=LEN_DEF) , dimension(size(bete)) :: manq 494 495 write(nficout,FMT='(/,/,' // & 496 '" ***************** TRAITS DESCRIPTION *****************",/)')! // & 497 ! '"The performance(s) file(s) is ",15(a10),/)') perfs 498 499 l = 0 500 501 do iperf=1,size(bete) 502 do kd=1,size(animal) 503 if(animal(kd) == bete(iperf)) exit 504 enddo 505 if ( kd <= size(animal)) cycle 506 l = l + 1 507 manq(l)=bete(iperf) 508 end do 509 if (l > 0) then 510 write(nficout,*) 'animal ',(trim(manq(i))//' ',i=1,l),' of performance file are not in the pedigree file' 511 end if 512 !! --------- BUFFER ARRAY FOR LOG ---------------------------------------------------------------- 513 allocate ( covmu(ncov), STAT = alloc_stat ) 514 call check_allocate(alloc_stat,'covmu') 515 allocate ( covsig(ncov), STAT = alloc_stat ) 516 call check_allocate(alloc_stat,'covsig') 517 allocate ( covmin(ncov), STAT = alloc_stat ) 518 call check_allocate(alloc_stat,'covmin') 519 allocate ( covmax(ncov), STAT = alloc_stat ) 520 call check_allocate(alloc_stat,'covmax') 521 allocate ( ncens(ncar), STAT = alloc_stat ) 522 call check_allocate(alloc_stat,'ncens') 523 allocate ( nmanq(ncar), STAT = alloc_stat ) 524 call check_allocate(alloc_stat,'nmanq') 525 allocate ( ymax(ncar), STAT = alloc_stat ) 526 call check_allocate(alloc_stat,'ymax') 527 allocate ( ymin(ncar), STAT = alloc_stat ) 528 call check_allocate(alloc_stat,'ymin') 529 530 do i=1, ncar 531 ncens(i)=0 532 nmanq(i)=0 533 ymax(i)=0.d0 534 ymin(i)=INIFINY_REAL_VALUE 535 do kd=1,nd 536 if((presentc(i,kd)) .and. ndelta(i,kd) == 0) ncens(i)=ncens(i)+1 537 if(.not. presentc(i,kd)) nmanq(i)=nmanq(i)+1 538 if(presentc(i,kd)) then 539 if(y(i,kd).GT.ymax(i)) ymax(i)=y(i,kd) 540 if(y(i,kd).LT.ymin(i)) ymin(i)=y(i,kd) 541 endif 542 enddo 543 enddo 544 545 do ico=1,ncov 546 covmax(ico)=0.d0 547 covmin(ico)=INIFINY_REAL_VALUE 548 sy=0.d0 549 nnn=0 550 sy2=0.d0 551 covmu(ico)=0.d0 552 covsig(ico)=0.d0 553 do kd=1,nd 554 if(covar(kd,ico) .ne. INIFINY_REAL_VALUE) then 555 if(covar(kd,ico).GT.covmax(ico)) covmax(ico)=covar(kd,ico) 556 if(covar(kd,ico).LT.covmin(ico)) covmin(ico)=covar(kd,ico) 557 sy=sy+covar(kd,ico) 558 nnn=nnn+1 559 endif 560 enddo 561 covmu(ico)=sy/(dble(nnn)) 562 do kd=1,nd 563 sy2=sy2+((covar(kd,ico)-covmu(ico))*(covar(kd,ico)-covmu(ico))) 564 enddo 565 covsig(ico)=sqrt(sy2/(dble(nnn-1.d0))) 566 enddo 567 568 !!-------------------------------------------------------------------------- 569 570 ! IMPRESSION DU DESCRIPTIF DES DONNEES 571 572 ngeno=0 573 do kd=1,nd 574 do ic=1, size(presentc,1) 575 !si il existe au moin un chromosome genotype pour l animal kd 576 if ((count(presentg(:,kd)) >= 1) .and. presentc(ic,kd))then 577 ngeno=ngeno+1 578 exit 579 end if 580 end do 581 end do 582 583 584 write(nficout,FMT='(/,5x,"NUMBER OF PHENOTYPED ANIMALS : ",i5/,' // & 585 '5x,"NUMBER OF PHENOTYPED AND GENOTYPED ANIMALS : ",i5/,' // & 586 '5x,"NUMBER OF TRAITS : ",i5/,' // & 587 '5x,"NUMBER OF FIXED EFFECTS : ",i5/,' // & 588 '5x,"NUMBER OF COVARIABLES : ",i5)') size(bete),ngeno, ncar, nfix, ncov 589 590 591 !POUR LES COVARIABLES 592 593 if( nfix /= 0 ) then 594 do ifx=1,nfix 595 write(nficout,*) 'FIXED EFFECT Num:', ifx,trim(namefix(ifx)), & 596 'HAS', nlev(ifx),'LEVELS: ', & 597 (trim(listelev(ifx,ilev))//" ",ilev=1,nlev(ifx)) 598 end do 599 end if 600 601 if(ncov /= 0) then 602 do ico=1,ncov 603 write(nficout,FMT='(" COVARIABLE Num",i2,", ", a15,' // & 604 '" MEAN = ",f8.3,"+-",f8.3," (MIN=",f8.3,",MAX=",f8.3,")")')& 605 ico,trim(trim(namecov(ico))),covmu(ico),covsig(ico), covmin(ico),covmax(ico) 606 end do 607 end if 608 609 ! 610 ! POUR CHAQUE CARACTERE 611 ! 612 do ic=1, ncar 613 if ((natureY(ic) == 'r' ).or.( natureY(ic) == 'a')) then 614 write (nficout,FMT= '(/,1x,"TRAIT :",a6/, 5x ' // & 615 ',"NUMBER OF PHENOTYPED PROGENY : ",i5/, 5x ' // & 616 ',"MEANS : ",f8.3, "+-"' // & 617 ',f8.3/, 5x,"MINIMUM : " ' // & 618 ',f8.3/, 5x,"MAXIMUM :",' // & 619 'f8.3/ , 5x,"NUMBER OF MISSING PHENOTYPES : ",' // & 620 'i5)')& 621 trim(trim(carac(ic))),(nd-nmanq(ic)),xmut(ic),sigt(ic),(ymin(ic)*sigt(ic)+xmut(ic)),& 622 (ymax(ic)*sigt(ic)+xmut(ic)),nmanq(ic) 623 endif 624 if ( natureY(ic) == 'i' ) then 625 write (nficout,FMT= '(/,1x,"TRAIT :",a6/, 5x ' // & 626 ',"NUMBER OF PHENOTYPED PROGENY : ",i5/ ' // & 627 ',5x,"MINIMUM : " ' // & 628 ',f8.3/, 5x,"MAXIMUM :",' // & 629 'f8.3/ , 5x,"NUMBER OF MISSING PHENOTYPES : ",' // & 630 'i5)')& 631 trim(trim(carac(ic))),(nd-nmanq(ic)),ymin(ic),ymax(ic),nmanq(ic) 632 633 write (nficout,FMT= '(/,1x," Class ",3x," Frequency ")') 634 635 do i=1,nmod(ic) 636 write (nficout,FMT= '(1x,i9,3x,f5.3)') indicemod(ic,i),prop(ic,i) 637 end do 638 639 end if 640 641 ! if (opt_calcul == ANALYSE_UNITRAIT_MODLIN_COX) then 642 write(nficout,FMT='( 5x,"NUMBER OF CENSORED PHENOTYPES :",I5)') ncens(ic) 643 ! end if 644 645 !POUR LES COVARIABLES 646 if (modele(ic,1).ne.0.AND.modele(ic,2).eq.0.AND.modele(ic,3).eq.0) then 647 write(nficout,*) ' MODEL = mu',(' + ',trim(namefix(modele(ic,3+ifx))),ifx=1,modele(ic,1)) 648 649 else if (modele(ic,1).eq.0.AND.modele(ic,2).ne.0.AND.modele(ic,3).eq.0) then 650 write(nficout,*) ' MODEL = mu',(' + ',trim(namecov(modele(ic,3+ico))),ico=1,modele(ic,2)) 651 652 else if (modele(ic,1).ne.0.AND.modele(ic,2).ne.0.AND.modele(ic,3).eq.0) then 653 write(nficout,*) ' MODEL = mu',(' + ',trim(namefix(modele(ic,3+ifx))),ifx=1,modele(ic,1)), & 654 (' + ',trim(namecov(modele(ic,3+modele(ic,1)+ico))),ico=1,modele(ic,2)) 655 656 else if (modele(ic,1).ne.0.AND.modele(ic,2).eq.0.AND.modele(ic,3).ne.0) then 657 write(nficout,*) ' MODEL = mu',(' + ',trim(namefix(modele(ic,3+ifx))),ifx=1,modele(ic,1)), & 658 (' + QTL*',trim(namefix(modele(ic,3+modele(ic,1)+modele(ic,2)+ifx))),ifx=1,modele(ic,3)) 659 660 else if (modele(ic,1).ne.0.AND.modele(ic,2).ne.0.AND.modele(ic,3).ne.0) then 661 write(nficout,*) ' MODEL = mu',(' + ',trim(namefix(modele(ic,3+ifx))),ifx=1,modele(ic,1)), & 662 (' + ',trim(namecov(modele(ic,3+modele(ic,1)+ico))),ico=1,modele(ic,2)),(' + QTL*', & 663 trim(namefix(modele(ic,3+modele(ic,1)+modele(ic,2)+jfx))),jfx=1,modele(ic,3)) 664 665 else if (modele(ic,1).eq.0.AND.modele(ic,2).eq.0.AND.modele(ic,3).ne.0) then 666 write(nficout,*) ' MODEL = mu',(' + QTL*',trim(namefix(modele(ic,3+modele(ic,1)+modele(ic,2)+jfx))), & 667 jfx=1,modele(ic,3)) 668 669 else if (modele(ic,1).eq.0.AND.modele(ic,2).ne.0.AND.modele(ic,3).ne.0) then 670 write(nficout,*) ' MODEL = mu',(' + ',trim(namecov(modele(ic,3+modele(ic,1)+ico))), & 671 ico=1,modele(ic,2)),(' + QTL*',trim(namefix(modele(ic,3+modele(ic,1)+modele(ic,2)+ifx))), & 672 ifx=1,modele(ic,3)) 673 else 674 write(nficout,*)'WITHOUT MODEL for fixed effects and covariables' 675 end if 676 end do 677 678 deallocate ( covmu ) 679 deallocate ( covsig ) 680 deallocate ( covmin ) 681 deallocate ( covmax ) 682 deallocate ( ncens ) 683 deallocate ( nmanq ) 684 deallocate ( ymax ) 685 deallocate ( ymin ) 686 687 end subroutine log_descriptif_traits
log_marker_description
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
log_marker_description
DESCRIPTION
SOURCE
380 subroutine log_marker_description() 381 integer :: i,j,k,jm,ip,igp,jgm 382 integer :: nmes0,l 383 character(len=LEN_DEF) , dimension(:),allocatable :: num_t 384 385 allocate( num_t (size(numero)) ) 386 num_t='' 387 !! compute number of animal which are not informative 388 nmes0 = 0 389 do i=1,size(animal) 390 if ( count(presentg(:,i)) == 0 ) nmes0 = nmes0 + 1 391 end do 392 l = 0 393 do i=1,nmes 394 do j=1,size(animal) 395 if (numero(i) == animal(j)) then 396 exit 397 endif 398 end do 399 400 if ( j <= size(animal) ) then 401 cycle 402 end if 403 404 do jm=1,size(mere) 405 if (mere(jm) == numero(i)) exit 406 enddo 407 if ( jm <= size(mere) ) cycle 408 do ip=1,size(pere) 409 if (pere(ip) == numero(i)) exit 410 enddo 411 if ( ip <= size(pere) ) cycle 412 do jgm=1,size(gmere) 413 if(gmere(jgm) == numero(i)) exit 414 enddo 415 if ( jgm <= size(gmere) ) cycle 416 do igp=1,size(gpere) 417 if(gpere(igp) == numero(i)) exit 418 enddo 419 if ( igp <= size(gpere) ) cycle 420 l = l + 1 421 num_t(l)=numero(i) 422 end do 423 424 write(nficout,FMT='(/,/,5x,' // & 425 '"***************** MARKER DESCRIPTION *****************",/)') 426 427 write (nficout,FMT='(i5, " animals are present in the genotype file ")') size(animal) 428 429 if (l > 0) then 430 if ( l<50) then 431 write(nficout,*) 'animal',(trim(num_t(i))//' ',i=1,l),'of genotype file ', & 432 'are not in the pedigree file' 433 else 434 write(nficout,*) l,' animals of genotype file are not in the pedigree file' 435 end if 436 437 end if 438 439 deallocate( num_t ) 440 441 442 443 if (nmes0.eq.0) then 444 write(nficout,*) 'where all animals are genotyped for at least ', & 445 'one marker.' 446 else 447 write(nficout,*) 'where',nmes0,'animals have no genotyped marker .' 448 endif 449 450 write(nficout,FMT='("markers were selected among ",i4," markers")') size(mark) 451 write(nficout,FMT='("There are ",i4," genotyped animals")') (size(animal)-nmes0) 452 453 if (trim(out_freqall)/='' ) then 454 write (nficout,*) " ** Check allele frequency in the file :",trim(out_freqall),' **' 455 end if 456 457 end subroutine log_marker_description
log_simulation_message
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
log_simulation_message
DESCRIPTION
SOURCE
696 subroutine log_simulation_message(simulMap,h2,ue,dens,nalle,taille) 697 logical , intent(in) :: simulMap 698 integer , intent(in) :: nalle 699 real (kind=dp) ,intent(in) :: dens,taille 700 real (kind=dp) ,dimension(:),intent(in) :: h2 701 real (kind=dp) ,dimension(:,:),intent(in) :: ue 702 703 integer :: ic,iq 704 705 write(nficout,*)'SIMULATION FOR NEW MOLECULAR DATA IS ONLY ',& 706 'AVAILABLE FOR REGULARLY SPACED MARKERS AND EQUAL', & 707 ' ALLELE FREQUENCIES' 708 709 if ( simulMap ) then 710 write(nficout,FMT="(1x,a8,'|',1x,f4.3,' M')") 'Densite ',dens 711 write(nficout,FMT="(1x,a8,'|',2x,i3,' alleles')") 'Nb all ',nalle 712 write(nficout,FMT="(1x,a8,'|',2x,f3.1,' M')") 'LongChr ',taille 713 write(nficout,FMT="(1x,a8,'|',2x,i3,' marq')") 'NbMarq ',nmk(1) 714 end if 715 716 if ( size(h2) <= 0 ) return 717 718 if ( size(h2) == size(carac)) then 719 write(nficout,*) 720 write(nficout,*) 'Trait heritabil effetsQTL' 721 write(nficout,*) 722 do ic=1,size(carac) 723 write(nficout,'(1x,a5,1x,i2,1x,40(f8.3,2x))')'trait ',ic,h2(ic), & 724 (ue(ic,iq), iq=1,size(ue,2)) 725 end do 726 else 727 write(nficout,*) 728 write(nficout,*) 'Trait effetsQTL' 729 write(nficout,*) 730 do ic=1,size(carac) 731 write(nficout,'(1x,a5,1x,i2,1x,40(f8.3,2x))')'trait ',ic, & 732 (ue(ic,iq), iq=1,size(ue,2)) 733 end do 734 end if 735 736 end subroutine log_simulation_message
print_allelic_origin
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_allelic_origin
DESCRIPTION
NOTE
SOURCE
2158 subroutine print_allelic_origin 2159 2160 integer :: i,g,ip,chr 2161 2162 write (nficout,*) 2163 do ip=1,np 2164 write (nficout,fmt="(' Allelic origin for ',a16)") pere(ip) 2165 do chr=1,nchr 2166 if ( phasp(chr,ip)) then 2167 write (nficout,fmt="('Chromosome ',a4,' : known')") chromo(chr) 2168 else 2169 write (nficout,fmt="('Chromosome ',a4,' : unknown')") chromo(chr) 2170 end if 2171 end do 2172 end do 2173 write (nficout,*) 2174 write (nficout,*) 'NOTE: known allelic origin means QTL effect = maternal - paternal allele effects' 2175 2176 2177 end subroutine print_allelic_origin
print_coeff_linear_combination
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_coeff_linear_combination
DESCRIPTION
SOURCE
1259 subroutine print_coeff_linear_combination(chr,ilong,npo,coeff) 1260 integer, intent(in) :: chr,npo,ilong 1261 real (kind=dp) ,intent(in) , dimension(size(carac),npo) :: coeff 1262 integer :: ic,ix,n,ios 1263 1264 if (trim(coeffda) == '' ) then 1265 return 1266 end if 1267 1268 open(UNIT=unit_coeff, file=trim(coeffda)//trim(str(chr)), form="formatted",recl=BUF_ALLOC_FILE,iostat=ios) 1269 if (ios/=0) then 1270 call stop_application("Can not open the file :"//trim(coeffda)) 1271 end if 1272 1273 write(unit_coeff,*) '# Coefficients of the linear combination' 1274 write(unit_coeff,3018) '# Position ', (trim(carac(ic)),ic=1,size(carac)) 1275 n=0 1276 do ix=0,ilong,pas 1277 n=n+1 1278 write(unit_coeff,3019) ix,(coeff(ic,n),ic=1,size(carac)) 1279 end do 1280 1281 3018 format(1x,a9,1x,30(a10,4x)) 1282 3019 format(2x,i4,3x,30(4x,f8.4,2x)) 1283 close(unit_coeff) 1284 1285 end subroutine print_coeff_linear_combination
print_coeff_linear_combination_max
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_coeff_linear_combination_max
DESCRIPTION
SOURCE
1238 subroutine print_coeff_linear_combination_max(coeff_max) 1239 real (kind=dp) ,intent(in) , dimension(size(carac)) :: coeff_max 1240 integer :: ic 1241 1242 write(nficout,*) 1243 write(nficout,*) 'Coefficients of the linear combination' 1244 write(nficout,3016) 'Trait ', (trim(carac(ic)),ic=1,size(carac)) 1245 write(nficout,3017) (coeff_max(ic),ic=1,size(carac)) 1246 1247 3016 format(1x,a6,1x,30(a10,4x)) 1248 3017 format(7x,30(4x,f8.4,2x)) 1249 1250 end subroutine print_coeff_linear_combination_max
print_confusion
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_confusion
DESCRIPTION
SOURCE
1294 subroutine print_confusion(nalert,alertCorrQtl,corrmax) 1295 integer ,intent(in) :: nalert 1296 type(CORR_ALERT_TYPE) ,dimension(nalert) ,intent(in) :: alertCorrQtl 1297 real (kind=dp) ,intent(in) :: corrmax 1298 character(len=LEN_L) :: fmts,fmtd 1299 character(LEN_W) :: last 1300 integer :: i 1301 1302 write (nficout,fmt="(//,80('*')/'Test of confusion between QTL ','and other effects in the final constained model',/,"//& 1303 "'(test based on the correlation between columns of the ','incidence matrix)',//)") 1304 1305 if (nalert == 0) then 1306 write(nficout,fmt="(/,' No confusion detected',/,' the highest correlation is : ', F7.3,/,80('*')/)") corrmax 1307 return 1308 end if 1309 1310 fmts="('Risk for sire ',a,' of confusion between the QTL ',i3,' level',i3,' and :')" 1311 fmtd="('Risk for dam ',a,' of confusion between the QTL ',i3,' level',i3,' and :')" 1312 last="" 1313 do i=1,nalert 1314 if (alertCorrQtl(i)%ip > 0 ) then 1315 if (trim(last)/=trim(pere(alertCorrQtl(i)%ip))) then 1316 write(nficout,*) 1317 write(nficout,fmt=fmts) trim(pere(alertCorrQtl(i)%ip)),alertCorrQtl(i)%qtl,alertCorrQtl(i)%ntlev 1318 last=trim(pere(alertCorrQtl(i)%ip)) 1319 end if 1320 end if 1321 if (alertCorrQtl(i)%jm > 0 ) then 1322 if (trim(last)/=trim(mere(alertCorrQtl(i)%jm))) then 1323 write(nficout,fmt=fmtd) trim(mere(alertCorrQtl(i)%jm)),alertCorrQtl(i)%qtl,alertCorrQtl(i)%ntlev 1324 last=trim(mere(alertCorrQtl(i)%jm)) 1325 end if 1326 end if 1327 write(nficout,*) alertCorrQtl(i)%name_effect,alertCorrQtl(i)%name_level,alertCorrQtl(i)%corr 1328 end do 1329 end subroutine print_confusion
print_courbe_LRT
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_courbe_LRT
DESCRIPTION
SOURCE
798 subroutine print_courbe_LRT(lrtsol) 799 type(TYPE_LRT_SOLUTION) ,intent(in) :: lrtsol 800 801 integer :: ipos,chr,nlong,s,t 802 real ,dimension(:), allocatable :: x_p,y_p 803 804 do chr=1,nchr 805 nlong=get_ilong(chr) 806 s=0 807 allocate (x_p(nlong),y_p(nlong)) 808 t=0 809 do ipos=1,nlong,pas 810 s=s+1 811 if(lrtsol%lrt1(chr,s) > 0.0d0) then 812 t=t+1 813 x_p(t) = absi(chr,s) 814 y_p(t) = lrtsol%lrt1(chr,s) 815 end if 816 end do 817 write (nficout,*) " ** chromosome "//trim(chromo(chr))//" ** " 818 call plott(y_p,x_p,t,nficout) 819 deallocate (x_p,y_p) 820 end do 821 end subroutine print_courbe_LRT
print_dam_phase
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_dam_phase
DESCRIPTION
NOTE
SOURCE
1883 subroutine print_dam_phase() 1884 real :: pb 1885 integer :: chr,jm,nd1,nd2,kd,ifem,nombfem,j,ii,ngeno1,ngeno2,maxp 1886 character(len=3) :: endline 1887 1888 nombfem=0 1889 do chr=1,nchr 1890 1891 if ( MAX_GENOTYP_PRINT < nmk(chr) ) then 1892 maxp = MAX_GENOTYP_PRINT 1893 endline="..." 1894 else 1895 maxp = nmk(chr) 1896 endline="" 1897 end if 1898 1899 endline="" 1900 1901 if ( trim(out_phases)/='' ) then 1902 write(unit_phases,*) 1903 write(unit_phases,*) ' ***************** DAM PARENTAL PHASES *****************' 1904 write(unit_phases,*) ' CHROMOSOME :',chromo(chr) 1905 write(unit_phases,*) 1906 end if 1907 1908 do jm=1,nm 1909 nd1=ndm(jm)+1 1910 nd2=ndm(jm+1) 1911 ngeno1=ngenom(chr,jm)+1 1912 ngeno2=ngenom(chr,jm+1) 1913 ifem=repfem(jm) 1914 1915 if ( estfem(ifem) ) then 1916 nombfem=nombfem+1 1917 1918 if (phasm(chr,jm)) then 1919 if ( trim(out_phases)/='' ) write(unit_phases,1000)trim(femelle(ifem)),(ngeno2-ngeno1+1) 1920 else 1921 if ( trim(out_phases)/='' ) write(unit_phases,1010)trim(femelle(ifem)),(ngeno2-ngeno1+1) 1922 end if 1923 1924 1000 format(/1x,'Dam ',associated,' has ',i3,' likely genotypes',' (paternal / maternal phases):') 1925 1010 format(/1x,'Dam ',associated,' has ',i3,' likely genotypes',' (unknown phase origins) :') 1926 1927 do j=ngeno1,ngeno2 1928 pb = probg(chr,j) 1929 if ( trim(out_phases)/='' ) then 1930 write(unit_phases,*)(trim(get_pheno(chr,genotypm(chr,ii,j,1)))//' ',ii=1,nmk(chr)),& 1931 trim(endline),' / ', & 1932 (trim(get_pheno(chr,genotypm(chr,ii,j,2)))//' ',ii=1,nmk(chr)),trim(endline),& 1933 ' proba : ',pb 1934 end if 1935 end do 1936 end if 1937 1938 end do 1939 end do 1940 if ( trim(out_phases)/='' ) then 1941 if(nombfem.eq.0) write(unit_phases,1020) 1942 end if 1943 1944 1020 format(/,'None of the females had more than the minimum number of progeny needed to estimate its possible phases') 1945 1946 1947 end subroutine print_dam_phase
print_end_multitraits
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_end_multitraits
DESCRIPTION
NOTE
SOURCE
1549 subroutine print_end_multitraits 1550 1551 end subroutine print_end_multitraits
print_end_unitrait
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_end_unitrait
DESCRIPTION
NOTE
SOURCE
1562 subroutine print_end_unitrait 1563 1564 end subroutine print_end_unitrait
print_freqall
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_freqall
DESCRIPTION
SOURCE
466 subroutine print_freqall 467 468 integer :: i,j,k 469 470 do i=1,nchr ! chr 471 do j=1,nmk(i) ! mark/chr 472 write(unit_freqall, & 473 FMT='(a," (Chr ",a,")"," has",i3," alleles:",90(" ",a,"(",f5.1,"%) ",a,"(",f5.1,"%)"))') & 474 trim(mark(i,j)),trim(chromo(i)),nall(i,j), ( trim(alleles(i,j,k)),pc_all(i,j,k), k=1,nall(i,j)) 475 end do 476 end do 477 478 end subroutine print_freqall
print_incidence_solution
[ Top ] [ m_qtlmap_analyse_unitrait ] [ Subroutines ]
NAME
print_incidence_solution
DESCRIPTION
SOURCE
2192 subroutine print_incidence_solution(incsol) 2193 type(TYPE_INCIDENCE_SOLUTION) , intent(in) :: incsol 2194 integer :: i,g,ip,chr,ic,l,iq 2195 real(kind=dp) :: wq 2196 2197 write(nficout,*) "---------------------------------------------------------------" 2198 write(nficout,*) 'Estimation of parameters under H'//trim(str(incsol%hypothesis)) 2199 write(nficout,*) "---------------------------------------------------------------" 2200 write(nficout,*) 2201 write(nficout,*) 'Within sire standard deviation' 2202 do ic=1,size(incsol%sig,1) 2203 if ( size(incsol%sig,1) > 1 ) then 2204 write(nficout,*) " ** Trait ",trim(carac(ic))," **" 2205 end if 2206 do ip = 1,np 2207 write(nficout,fmt="(' sire ',a, ' s.d. :',f10.3)") trim(pere(ip)),incsol%sig(ic,ip) 2208 end do 2209 end do 2210 2211 write(nficout,*) 2212 2213 write(nficout,"(//,' parameter ',' estimable ? value ','precision'/)") 2214 2215 do i=1,size(incsol%groupeName) 2216 write (nficout,*) incsol%groupeName(i) 2217 write (nficout,*) 2218 2219 if ( incsol%nbParameterGroup(i) == 1 ) then 2220 if ( incsol%parameterVecsol(i,1) ) then 2221 write (nficout,fmt="(a50,' yes ',2f10.3,1x)") " " , incsol%paramaterValue(i,1),& 2222 incsol%parameterPrecis(i,1) 2223 else 2224 write (nficout,fmt="(a50,' no ')") incsol%groupeName(i) 2225 end if 2226 else 2227 2228 do g=1,incsol%nbParameterGroup(i) 2229 if ( incsol%parameterVecsol(i,g) ) then 2230 write (nficout,fmt="(a50,' yes ',2f10.3,1x)") incsol%parameterName(i,g)& 2231 , incsol%paramaterValue(i,g) , incsol%parameterPrecis(i,g) 2232 else 2233 write (nficout,fmt="(a50,' no ')") incsol%parameterName(i,g) 2234 end if 2235 end do 2236 end if 2237 write (nficout,*) 2238 end do 2239 write(nficout,*)' NOTE: known allelic origin means QTL effect = maternal - paternal allele effects' 2240 2241 if (associated(incsol%rhoi)) call print_residual_correlation(incsol%rhoi) 2242 2243 write (nficout,*) ' *** ' 2244 write (nficout,*) ' The mean of absolute value of substitution effect WQ =' 2245 write (nficout,*) ' -------------------------- ' 2246 do iq=1,incsol%hypothesis 2247 if ( .not. associated(incsol%qtl_groupeName) ) then 2248 call stop_application("Devel error*** incsol%qtl_groupeName is not allocated"//& 2249 " [m_qtlmap_output_handler:print_incidence_solution] ") 2250 end if 2251 2252 ! Moyenne des valeurs absolues des effets de substitution 2253 do ic=1,size(incsol%sig,1) 2254 ! print *,iq,'QTLEFFECT:',incsol%qtl_groupeName(ic,iq) 2255 g = incsol%qtl_groupeName(ic,iq) ! get the index of qtl position effect 2256 if (g <= 0 .or. g > size(incsol%parameterVecsol,1)) cycle 2257 wq = 0 2258 l = 0 2259 do ip=1,np 2260 ! print *,incsol%parameterName(g,ip),incsol%groupeName(g) 2261 if (incsol%parameterVecsol(g,ip)) then 2262 wq = wq + abs( incsol%paramaterValue(g,ip) / incsol%sig(ic,ip)) 2263 l = l + 1 2264 end if 2265 end do 2266 wq = wq / l 2267 if ( size(incsol%sig,1) > 1 ) then 2268 write (nficout,fmt="(' | qtl ',i5, ' | wq :',f10.3,' |',a)") iq,wq,trim(carac(ic)) 2269 else 2270 write (nficout,fmt="(' | qtl ',i5, ' | wq :',f10.3,' |')") iq,wq 2271 end if 2272 end do 2273 end do 2274 write (nficout,*) ' -------------------------- ' 2275 2276 end subroutine print_incidence_solution
print_incidence_solution_risk_factor
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_incidence_solution_risk_factor
DESCRIPTION
NOTE
SOURCE
2287 subroutine print_incidence_solution_risk_factor(incsol) 2288 type(TYPE_INCIDENCE_SOLUTION) , intent(in) :: incsol 2289 2290 integer :: i,g,ip,chr,ic 2291 2292 write(nficout,*) "---------------------------------------------------------------" 2293 write(nficout,*) 'Estimation of parameters under H'//trim(str(incsol%hypothesis)) 2294 write(nficout,*) "---------------------------------------------------------------" 2295 write(nficout,*) 2296 write(nficout,*) 2297 2298 write(nficout,"(//,' parameter ',' estimable ? risk factor '/)") 2299 2300 do i=1,size(incsol%groupeName) 2301 write (nficout,*) incsol%groupeName(i) 2302 write (nficout,*) 2303 2304 if ( incsol%nbParameterGroup(i) == 1 ) then 2305 if ( incsol%parameterVecsol(i,1) ) then 2306 write (nficout,fmt="(a25,' yes ',2f10.3,1x)") " " , incsol%paramaterValue(i,1) 2307 else 2308 write (nficout,fmt="(a25,' no ')") incsol%groupeName(i) 2309 end if 2310 else 2311 2312 do g=1,incsol%nbParameterGroup(i) 2313 if ( incsol%parameterVecsol(i,g) ) then 2314 write (nficout,fmt="(a25,' yes ',f10.3,1x)") incsol%parameterName(i,g), incsol%paramaterValue(i,g) 2315 else 2316 write (nficout,fmt="(a25,' no ')") incsol%parameterName(i,g) 2317 end if 2318 end do 2319 end if 2320 write (nficout,*) 2321 end do 2322 2323 write(nficout,*)' NOTE: known allelic origin means QTL effect = maternal - paternal allele effects' 2324 2325 end subroutine print_incidence_solution_risk_factor
print_LRT
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_LRT
DESCRIPTION
NOTE
SOURCE
1618 subroutine print_LRT(lrtsol) 1619 type(TYPE_LRT_SOLUTION) :: lrtsol 1620 1621 integer :: i,ii,npo,chr 1622 character(len=100) :: FMT1,FMT2 1623 1624 if ( (trim(resp)=='' ) .and. (trim(resm)=='' )) then 1625 return 1626 end if 1627 1628 FMT1="(1x,i3,f8.3,1x,f7.2,"// trim(str(np)) //"(1x,f7.2))" 1629 FMT2="(1x,i3,f8.3,"// trim(str(nm)) //"(1x,f7.2))" 1630 1631 if ( trim(resp)/='' ) write(unit_sire_res,*)" Chr Pos GlobalLRT ",(" "// trim(pere(ii)),ii=1,np ) 1632 if ( trim(resm)/='' ) write(unit_dam_res,*)" Chr Pos ",(" "// trim(mere(ii)),ii=1,nm ) 1633 1634 if (file) then 1635 do chr=1,nchr 1636 npo = get_npo(chr) 1637 do i=1,npo 1638 if ( trim(resp)/='' ) write(unit_sire_res,FMT=FMT1)& 1639 chr,absi(chr,i),lrtsol%lrt1(chr,i),(lrtsol%xlrp(chr,ii,i),ii=1,np) 1640 if ( trim(resm)/='' ) write(unit_dam_res,FMT=FMT2)& 1641 chr,absi(chr,i),(lrtsol%xlrm(chr,ii,i),ii=1,nm) 1642 end do 1643 end do 1644 end if 1645 1646 end subroutine print_LRT
print_LRT_2QTL
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_LRT_2QTL
DESCRIPTION
NOTE
SOURCE
1713 subroutine print_LRT_2QTL(lrtsol) 1714 type(TYPE_LRT_SOLUTION) ,intent(in) :: lrtsol 1715 1716 integer :: i,j,ii,chr,chr2,init 1717 character(len=100) :: FMT1,FMT2 1718 1719 if ( (trim(resp)=='' ) .and. (trim(resm)=='' )) then 1720 return 1721 end if 1722 1723 FMT1="(1x,i5,1x,i5,1x,f7.2,1x,f7.2,1x,f7.2,"// trim(str(np)) //"(1x,f7.2))" 1724 FMT2="(1x,i5,1x,i5,1x,f7.2,1x,f7.2,"// trim(str(nm)) //"(1x,f7.2))" 1725 1726 if ( trim(resp)/='' ) write(unit_sire_res,*)& 1727 " Chr1 Chr2 Pos1 Pos2 GlobalLRT ",(" "// trim(pere(ii)),ii=1,np ) 1728 if ( trim(resm)/='' ) write(unit_dam_res,*)& 1729 " Chr1 Chr2 Pos1 Pos2 ",(" "// trim(mere(ii)),ii=1,nm ) 1730 1731 if (file) then 1732 do chr=1,nchr 1733 do i=1,get_npo(chr)-1 1734 do chr2=chr,nchr 1735 init=1 1736 if ( chr2 == chr ) init=i+1 1737 do j=init,get_npo(chr2) 1738 if ( trim(resp)/='' ) write(unit_sire_res,FMT=FMT1)& 1739 chr,chr2,absi(chr,i),absi(chr2,j),lrtsol%lrt1_2(chr,chr2,i,j),(lrtsol%xlrp2(chr,chr2,ii,i,j),ii=1,np) 1740 if ( trim(resm)/='' ) write(unit_dam_res,FMT=FMT2)& 1741 chr,chr2,absi(chr,i),absi(chr2,j),(lrtsol%xlrm2(chr,chr2,ii,i,j),ii=1,nm) 1742 end do 1743 end do 1744 end do 1745 end do 1746 end if 1747 1748 end subroutine print_LRT_2QTL
print_lrt_solution
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_lrt_solution
DESCRIPTION
NOTE
SOURCE
2336 subroutine print_lrt_solution(lrtsol) 2337 type(TYPE_LRT_SOLUTION) ,intent(in) :: lrtsol 2338 integer :: iq 2339 character(len=1) :: l 2340 2341 if ( lrtsol%nqtl <= 0 ) return 2342 write(nficout,*) " ***** " 2343 if ( lrtsol%nqtl == 1 ) then 2344 call print_courbe_LRT(lrtsol) 2345 end if 2346 2347 write(nficout,fmt="(//1x,'Maximum likelihood ratio test :'/)") 2348 l='1' 2349 if (lrtsol%nqtl >= 10 ) l='2' 2350 2351 do iq=1,lrtsol%nqtl 2352 write(nficout,fmt="('Test H',i"//l//",' / H',i"//l//",' : ',f9.5,/)") iq-1, lrtsol%nqtl, lrtsol%lrtmax(iq-1) 2353 end do 2354 2355 ! if ( lrtsol%nxmax(iq) > 0 .and. lrtsol%chrmax(iq) > 0 ) then 2356 write(nficout,fmt="(1x,'The maximum is reached at position(s) ',"//trim(str(lrtsol%nqtl))//"(f9.4,'(Chr :',a4,') '))") & 2357 (absi(lrtsol%chrmax(iq),lrtsol%nxmax(iq)),chromo(lrtsol%chrmax(iq)),iq=0,lrtsol%nqtl-1) 2358 ! end if 2359 2360 end subroutine print_lrt_solution
print_maximum_LRT
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_maximum_LRT
DESCRIPTION
SOURCE
1194 subroutine print_maximum_LRT(dxmax,xlrmax) 1195 real (kind=dp) ,intent(in) :: dxmax,xlrmax 1196 1197 write(nficout,3003) 1198 3003 format(//1x,'Maximum likelihood ratio test :'/) 1199 write(nficout,3000)dxmax,xlrmax 1200 3000 format(1x,'The maximum is reached at position ',f8.4,' M, with value ',f8.3/) 1201 1202 end subroutine print_maximum_LRT
print_offspring_phase
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_offspring_phase
DESCRIPTION
NOTE
SOURCE
1810 subroutine print_offspring_phase(c,mktot1,mktot2,namefile) 1811 integer ,intent(in) :: c,mktot1, mktot2 1812 character(len=LENGTH_MAX_FILE) , intent(in) :: namefile 1813 !local 1814 integer :: ip,jm,kd,k,ios 1815 Character(len=LEN_DEF) :: hap_print(maxval(nmk),2) 1816 integer :: unit_p=888 1817 1818 open(UNIT=unit_p,file=namefile, form="formatted",recl=2**16,iostat=ios) 1819 if ( ios /= 0 ) then 1820 call stop_application("Can not create file:"//trim(namefile)) 1821 end if 1822 1823 write(unit_p,*) 1824 write(unit_p,*) ' ***************** OFFSPRING PHASES *****************' 1825 write(unit_p,*) ' CHROMOSOME :',chromo(c) 1826 write(unit_p,*) 1827 write(unit_p,fmt="(' MARKER:',a,' (',f7.5,' M)',' ==> ','MARKER:',a,' (',f7.5,' M)')") & 1828 trim(mark(c,mktot1)),posi(c,mktot1),trim(mark(c,mktot2)),posi(c,mktot2) 1829 1830 do ip=1,np 1831 do jm=nmp(ip)+1,nmp(ip+1) 1832 do kd=ndm(jm)+1,ndm(jm+1) 1833 hap_print='.' 1834 IF(count(presentg(:,kd))>0) then !condition pour sélectionner les individus génotypés 1835 DO k=mktot1,mktot2 !boucle sur les marqueurs 1836 1837 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1838 ! 3) CREATION D'un haplotype contenant des lettres en minuscule lorsqu'il est prédit pour les génotypes en charactère 1839 ! le genotype suivit d'un p lorsqu'il est prédit pour les génotypes en chiffres 1840 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1841 hap_print(k,1)=get_pheno(c,genotyp(c,k,corred(kd),1)) 1842 hap_print(k,2)=get_pheno(c,genotyp(c,k,corred(kd),2)) 1843 if (reconstructed(c,corred(kd),k)) then 1844 hap_print(k,1)=trim(get_pheno(c,genotyp(c,k,corred(kd),1)))//'p' 1845 hap_print(k,2)=trim(get_pheno(c,genotyp(c,k,corred(kd),2)))//'p' 1846 !write(unit_p,*) 'marqueur',k,' ', ph,' ', ph1,' ', ph2 1847 endif 1848 !! A mettre dans m_qtlmap_output_handler par olivier -->CMO 1849 ENDDO ! boucle marker mktot1 mktot2 1850 1851 !! A mettre dans m_qtlmap_output_handler par olivier -->CMO 1852 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1853 ! 4) IMPRESSION DES PHASES COMPLETES 1854 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1855 if ( trim(out_phases)/='' ) then 1856 write(unit_p,*) & 1857 trim(animal(kd)),' ',trim(pere(ip)),' ',trim(mere(jm)), ' ','s',' ', & 1858 (trim(hap_print(k,1))//' ',k=mktot1, mktot2) !, & 1859 write(unit_p,*) & 1860 trim(animal(kd)),' ',trim(pere(ip)),' ',trim(mere(jm)), ' ','d',' ', & 1861 ( trim(hap_print(k,2))//' ',k=mktot1, mktot2) !, & 1862 endif 1863 ENDIF 1864 ENDDO 1865 ENDDO 1866 ENDDO 1867 close(unit_p) 1868 1869 end subroutine print_offspring_phase
print_pat_mat_effect_2QTL
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_pat_mat_effect_2QTL
DESCRIPTION
NOTE
SOURCE
1657 subroutine print_pat_mat_effect_2QTL(ic,lrtsol) 1658 integer , intent(in) :: ic 1659 type(TYPE_LRT_SOLUTION) ,intent(in) :: lrtsol 1660 1661 integer :: i,j,ip,jm,iq,init,chr,chr2 1662 character(len=100) :: FMT1,FMT2 1663 1664 if ( ( trim(mateff)=='' ) .and. ( trim(pateff)=='' )) then 1665 return 1666 end if 1667 1668 FMT1="(1x,i5,1x,i5,1x,f8.3,1x,f8.3,"// trim(str(np*2)) //"(1x,f7.2))" 1669 if ( namest(ic) /= 0 ) then 1670 FMT2="(1x,i5,1x,i5,1x,f8.3,1x,f8.3,"// trim(str(namest(ic)*2)) //"(1x,f7.2))" 1671 else 1672 FMT2="(1x,i5,1x,i5,1x,f8.3,1x,f8.3,1x,f7.2)" 1673 end if 1674 1675 if ( trim(pateff)/='' ) write(unit_paternal_effects,*)& 1676 " Chr1 Chr2 Pos1 "," Pos2 ",(( " "// trim(pere(ip))//"/Qtl["//& 1677 trim(str(iq))//"] ",iq=1,2),ip=1,np) 1678 1679 !il faut afficher que les mere estimable..... 1680 ! if ( trim(mateff)/='' ) write(unit_maternal_effects,*)& 1681 ! " Chr1 Chr2 Pos1 "," Pos2 ",(( " "// trim(mere(jm))//"/Qtl["//& 1682 ! trim(str(iq))//"] ",iq=1,2),jm=1,namest(ic)) 1683 1684 if (file) then 1685 do chr=1,nchr 1686 do i=1,get_npo(chr)-1 1687 do chr2=chr,nchr 1688 init=1 1689 if ( chr2 == chr ) init=i+1 1690 do j=init,get_npo(chr2) 1691 if ( trim(pateff)/='' ) & 1692 write(unit_paternal_effects,FMT=FMT1)& 1693 chr,chr2,absi(chr,i),absi(chr2,j),((lrtsol%pater_eff2(chr,chr2,ip,i,j,iq),iq=1,2),ip=1,np) 1694 if ( trim(mateff)/='' ) & 1695 write(unit_maternal_effects,FMT=FMT2)& 1696 chr,chr2,absi(chr,i),absi(chr2,j),((lrtsol%mater_eff2(chr,chr2,jm,i,j,iq),iq=1,2),jm=1,namest(ic)) 1697 end do 1698 end do 1699 end do 1700 end do 1701 end if 1702 end subroutine print_pat_mat_effect_2QTL
print_paternal_maternal_effect
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_paternal_maternal_effect
DESCRIPTION
NOTE
SOURCE
1575 subroutine print_paternal_maternal_effect(ic,lrtsol) 1576 integer ,intent(in) :: ic 1577 type(TYPE_LRT_SOLUTION) ,intent(in) :: lrtsol 1578 1579 integer :: i,ii,npo,chr 1580 character(len=100) :: FMT1,FMT2 1581 1582 if ( ( trim(mateff)=='' ) .and. ( trim(pateff)=='' )) then 1583 return 1584 end if 1585 1586 FMT1="(1x,i3,f8.3,"// trim(str(np)) //"(1x,f7.2))" 1587 if ( namest(ic) /= 0 ) then 1588 FMT2="(1x,i3,f8.3,"// trim(str(namest(ic))) //"(1x,f7.2))" 1589 else 1590 FMT2="(1x,i3,f8.3,1x,f7.2)" 1591 end if 1592 1593 if ( trim(pateff)/='' ) write(unit_paternal_effects,*)" Chr Pos ",(" "// trim(pere(ii)),ii=1,np ) 1594 if ( trim(mateff)/='' ) write(unit_maternal_effects,*)" Chr Pos ",(" "// trim(mere(ii)),ii=1,namest(ic) ) 1595 1596 if (file) then 1597 do chr=1,nchr 1598 npo = get_npo(chr) 1599 do i=1,npo 1600 if ( trim(pateff)/='' ) write(unit_paternal_effects,FMT=FMT1)& 1601 chr, absi(chr,i),(lrtsol%pater_eff(chr,ii,i),ii=1,np) 1602 if ( trim(mateff)/='' ) write(unit_maternal_effects,FMT=FMT2)& 1603 chr,absi(chr,i),(lrtsol%mater_eff(chr,ii,i),ii=1,namest(ic)) 1604 end do 1605 end do 1606 end if 1607 end subroutine print_paternal_maternal_effect
print_pded
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_pded
DESCRIPTION
NOTE
SOURCE
1958 subroutine print_pded(chr) 1959 integer, intent(in) :: chr 1960 1961 real (kind=dp) :: app,apm,pp,pm,dx 1962 integer :: ip,nm1,nm2,ngeno1,ngeno2,jm,geno,igeno,kd,kkd,n,nd1,nd2,ios 1963 1964 if ( (trim(pdedf) == '' ) .and. ( trim(pdecouple) =='') ) then 1965 return 1966 end if 1967 1968 if ( trim(pdedf) /= '' ) then 1969 open(UNIT=unit_pded, file=trim(pdedf)//'_'//trim(str(chr)), form="formatted",recl=BUF_ALLOC_FILE,iostat=ios) 1970 if (ios/=0) then 1971 call stop_application("Can not open the file :"//trim(pdedf)) 1972 end if 1973 end if 1974 1975 if ( trim(pdecouple) /= '' ) then 1976 open(UNIT=unit_pdedjoin, file=trim(pdecouple)//'_'//trim(str(chr)), form="formatted",recl=BUF_ALLOC_FILE,iostat=ios) 1977 if (ios/=0) then 1978 call stop_application("Can not open the file :"//trim(pdecouple)) 1979 end if 1980 end if 1981 1982 if ( trim(pdedf) /= '' ) & 1983 write(unit_pded,*) 'Position Sire Dam Dam_Phase Animal p(2nd sire allele) p(2nd dam allele) ' 1984 1985 if ( trim(pdecouple) /= '' ) & 1986 write(unit_pdedjoin,*) 'Position Sire Dam Dam_Phase Animal p(Hs1/Hd1 ) p(Hs1/Hd2 ) p(Hs2/Hd1 ) p(Hs2/Hd2 ) ' 1987 1988 do ip=1,np 1989 nm1=nmp(ip)+1 1990 nm2=nmp(ip+1) 1991 do jm=nm1,nm2 1992 ngeno1=ngenom(chr,jm)+1 1993 ngeno2=ngenom(chr,jm+1) 1994 do geno=ngeno1,ngeno2 1995 igeno=ngeno2-geno+1 1996 nd1=ngend(chr,geno)+1 1997 nd2=ngend(chr,geno+1) 1998 do kd=nd1,nd2 1999 kkd=ndesc(chr,kd) 2000 do n=1,(get_npo(chr)-1) 2001 dx=absi(chr,n) 2002 2003 if(.not. estfem(repfem(jm)).or.opt_sib.eq.OPT_SIB_HS) then 2004 pp=-pdd(chr,kd,1,n)+pdd(chr,kd,3,n) 2005 app=(pp+1.d0)/2.d0 2006 if ( trim(pdedf) /= '' ) then 2007 write(unit_pded,333) dx,trim(pere(ip)),trim(mere(jm)),igeno,trim(animal(kkd)),app,0.5d0 2008 end if 2009 ! 2010 ! Impression des probabilites des couples d'haplo parentaux 2011 if ( trim(pdecouple) /= '' ) then 2012 write(unit_pdedjoin,334) dx,trim(pere(ip)),trim(mere(jm)),igeno,trim(animal(kkd)),& 2013 0.5d0*pdd(chr,kd,1,n),0.5d0*pdd(chr,kd,1,n),& 2014 0.5d0*pdd(chr,kd,3,n),0.5d0*pdd(chr,kd,3,n) 2015 !332 format(2x,f8.3,1x,a12,1x,a12,1x,2(5x,f8.3)) 2016 end if 2017 2018 else !OPT_SIB_FS 2019 2020 pp=-pdd(chr,kd,1,n)-pdd(chr,kd,2,n)+pdd(chr,kd,3,n)+pdd(chr,kd,4,n) 2021 pm=-pdd(chr,kd,1,n)+pdd(chr,kd,2,n)-pdd(chr,kd,3,n)+pdd(chr,kd,4,n) 2022 app=(pp+1.d0)/2.d0 2023 apm=(pm+1.d0)/2.d0 2024 2025 2026 !Impression des probabilites des haplo parentaux 2027 if ( trim(pdedf) /= '' ) then 2028 write(unit_pded,333) dx,trim(pere(ip)),trim(mere(jm)),igeno,trim(animal(kkd)),app,apm 2029 end if 2030 2031 333 format(2x,f8.3,1x,2(a12,1x),i5,1x,a12,1x,2(12x,f8.3)) 2032 !Impression des probabilites des couples d'haplo parentaux 2033 if ( trim(pdecouple) /= '' ) then 2034 write(unit_pdedjoin,334) dx,trim(pere(ip)),trim(mere(jm)),igeno,& 2035 trim(animal(kkd)),pdd(chr,kd,1,n),pdd(chr,kd,2,n),pdd(chr,kd,3,n),pdd(chr,kd,4,n) 2036 end if 2037 2038 334 format(2x,f8.3,1x,2(a12,1x),i5,1x,a12,1x,4(5x,f8.3)) 2039 2040 end if 2041 2042 end do ! N 2043 end do ! KD 2044 end do ! GENO 2045 end do ! JM 2046 end do ! IP 2047 2048 if ( trim(pdedf) /= '' ) close(unit_pded) 2049 if ( trim(pdecouple) /= '' ) close(unit_pdedjoin) 2050 2051 end subroutine print_pded
print_residual_correlation
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_residual_correlation
DESCRIPTION
SOURCE
1211 subroutine print_residual_correlation(rhoi) 1212 real (kind=dp) ,intent(in) ,dimension(:,:) :: rhoi 1213 integer :: ic,jc 1214 1215 if (size(rhoi,1) /= size(rhoi,2)) then 1216 call stop_application("Devel error: print_residual_correlation") 1217 end if 1218 1219 write(nficout,*) 1220 write(nficout,*) 'Residual Correlations ' 1221 write(nficout,3015) (ic,ic=1,size(rhoi,1)-1) 1222 1223 do ic=2,size(rhoi,1) 1224 write(nficout,3014) ic,(rhoi(ic,jc),jc= 1,ic-1) 1225 end do 1226 3014 format(7x,i3,1x,30(f6.3,4x)) 1227 3015 format(10x,30(1x,i3,9x)) 1228 1229 end subroutine print_residual_correlation
print_resume_simulation
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_resume_simulation
DESCRIPTION
NOTE
SOURCE
2062 subroutine print_resume_simulation(trait,test,ns,YMU1,SIG1,S21,S31,XMIN1,XMAX1,prob,z,minP,maxP) 2063 character(len=*),intent(in) :: trait,test 2064 integer ,intent(in) :: ns 2065 real(kind=dp) ,intent(in) :: YMU1,SIG1,S21,S31,XMIN1,XMAX1 2066 real(kind=dp) ,dimension(16),intent(in) :: prob,z 2067 integer ,intent(in) :: minP,maxP 2068 integer :: ii 2069 write(nficout,*) 2070 write(nficout,4004) trim(trait) 2071 4004 format( & 2072 1X,'*---------------------------------------*' & 2073 ,/, & 2074 1x,' Variable ',associated) 2075 2076 write(nficout,4015) test 2077 4015 format( & 2078 1X,'*---------------------------------------*' & 2079 ,/, & 2080 1x,' Test ',associated & 2081 ,/, & 2082 &1X,'*---------------------------------------*',/) 2083 2084 WRITE(nficout,6103)ns,YMU1,SIG1,S21,S31,XMIN1,XMAX1 2085 6103 FORMAT( & 2086 1X,' Test statistic distribution :',/, & 2087 1X,' Number of simulations : ',i6,/, & 2088 1X,' Mean : ',F12.5,/, & 2089 1X,' Standard deviation : ',F12.5,/, & 2090 1X,' Skewness : ',F12.5,/, & 2091 1X,' Kurtosis : ',F12.5,/, & 2092 1X,' Minimum : ',F12.5,/, & 2093 1X,' Maximum : ',F12.5,/) 2094 2095 write(nficout,4005) 2096 4005 format( & 2097 1X,'*--------------------------------------*' & 2098 ,/, & 2099 1x,'| chromosome | genome | Threshold |' & 2100 ,/, & 2101 1x,'| level | |' & 2102 ,/, & 2103 1X,'|--------------------------------------|') 2104 do ii=minP,maxP 2105 if (ii.eq.11)write(nficout,4007) 1-prob(ii),'chrom_level',z(ii) 2106 if (ii.eq.12)write(nficout,4007) 1-prob(ii),' * ',z(ii) 2107 if (ii.eq.13)write(nficout,4007) 1-prob(ii),' nb_chrom ',z(ii) 2108 if (ii.lt.11.or.ii.gt.13)write(nficout,4007) 1-prob(ii),' ',z(ii) 2109 4007 format(1x,'|',2x,F7.4,3x,'|',a12,'|',2x,F8.2,2x,'|') 2110 end do 2111 write(nficout,*)'*--------------------------------------*' 2112 2113 end subroutine print_resume_simulation
print_resume_simulation_2
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_resume_simulation_2
DESCRIPTION
NOTE
SOURCE
2124 subroutine print_resume_simulation_2(test,ncar,carac,z) 2125 character(len=*),intent(in) :: test 2126 integer ,intent(in) :: ncar 2127 character(len=*),dimension(ncar),intent(in) :: carac 2128 real(kind=dp) ,dimension(ncar,16),intent(in) :: z 2129 2130 integer :: i 2131 2132 2133 write(nficout,4009) test 2134 4009 format(/, & 2135 ' ',a8,' p_value at ' & 2136 ,/, & 2137 'Trait chromosome level ', & 2138 ' genome level ',/, & 2139 ' 5% 1% 0.1% 5% 1% ', & 2140 ' 0.1%',/) 2141 2142 do i=1,ncar 2143 write(nficout,4010)carac(i),z(i,10),z(i,11),z(i,14),z(i,13),z(i,15),z(i,16) 2144 end do 2145 4010 format(a8,4x,F6.2,4x,F6.2,4x,F6.2,8x,F6.2,4x,F6.2,4x,F6.2) 2146 2147 end subroutine print_resume_simulation_2
print_sire_phase
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_sire_phase
DESCRIPTION
NOTE
SOURCE
1759 subroutine print_sire_phase() 1760 integer :: ip,i,maxp,chr 1761 character(len=LEN_DEF) :: sep,sep2 1762 1763 do chr=1,nchr 1764 sep=' ' 1765 sep2=' / ' 1766 1767 write(nficout,*) 1768 write(nficout,*) ' ***************** PARENTAL PHASES *****************' 1769 write(nficout,*) ' FILE :',trim(out_phases) 1770 write(nficout,*) ' ***************************************************' 1771 1772 if ( trim(out_phases)/='' ) then 1773 write(unit_phases,*) 1774 write(unit_phases,*) ' ***************** SIRE PARENTAL PHASES *****************' 1775 write(unit_phases,*) ' CHROMOSOME :',chromo(chr) 1776 write(unit_phases,*) 1777 end if 1778 1779 do ip=1,size(pere) 1780 if(phasp(chr,ip)) then 1781 if ( trim(out_phases)/='' ) then 1782 !write(unit_phases,1000) trim(pere(ip)) 1783 write(unit_phases,*) trim(pere(ip)),' s ',(trim(get_pheno(chr,genotyp(chr,i,correp(ip),1)))//' ',i=1,nmk(chr))!,' / ',& 1784 write(unit_phases,*) trim(pere(ip)),' d ',(trim(get_pheno(chr,genotyp(chr,i,correp(ip),2)))//' ',i=1,nmk(chr)) 1785 end if 1786 else 1787 if ( trim(out_phases)/='' ) then 1788 !write(unit_phases,1001)trim(pere(ip)) 1789 write(unit_phases,*) trim(pere(ip)),' ? ' ,(trim(get_pheno(chr,genotyp(chr,i,correp(ip),1)))//' ',i=1,nmk(chr))!,' / ',& 1790 write(unit_phases,*) trim(pere(ip)),' ? ' ,(trim(get_pheno(chr,genotyp(chr,i,correp(ip),2)))//' ',i=1,nmk(chr)) 1791 end if 1792 end if 1793 1794 1000 format(/1x,'Sire ',associated,' genotype (paternal / maternal phases): ') 1795 1001 format(/1x,'Sire ',associated,' genotype (unknown phase origins): ') 1796 1797 end do 1798 end do 1799 end subroutine print_sire_phase
print_start_multitrait_DA
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_start_multitrait_DA
DESCRIPTION
SOURCE
761 subroutine print_start_multitrait_DA 762 763 write(nficout,1100) 764 1100 format(//9x,36('*')/9x,'*',34x,'*'/9x, & 765 '* Joint analysis of the traits *'/9x, & 766 '* using a discriminant function *'/9x, & 767 '*',34x,'*'/9x,36('*')//) 768 769 end subroutine print_start_multitrait_DA
print_start_multitraits
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_start_multitraits
DESCRIPTION
SOURCE
745 subroutine print_start_multitraits() 746 747 write(nficout,1100) 748 1100 format(//9x,36('*')/9x,'*',34x,'*'/9x, & 749 '* Joint analysis of the traits *'/9x, & 750 '*',34x,'*'/9x,36('*')//) 751 752 end subroutine print_start_multitraits
print_start_unitrait
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_start_unitrait
DESCRIPTION
SOURCE
778 subroutine print_start_unitrait(name_trait) 779 character(len=LEN_DEF) ,intent(in) :: name_trait 780 781 write(nficout,1000) trim(name_trait) 782 783 1000 format(//9x,36('*')/9x,'*',34x,'*'/9x,'* Analysis of trait ',a8,' *'/9x,'*',& 784 34x,'*'/9x,'*',34x,'*'/9x,36('*')//) 785 write(nficout,1001)np,nfem 786 1001 format(1x,'LRT profile on the linkage group :'/1x,' position, test statistic , '/3x,i3,& 787 ' sire QTL effects , '/3x,i3,' dam QTL effects') 788 789 end subroutine print_start_unitrait
print_summary_analyse
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_summary_analyse
DESCRIPTION
NOTE A MODIFIER print_summary_analyse pour prendre en compte les effets d interaction QTL
SOURCE
1373 subroutine print_summary_analyse(listlrtsol,listincsol,nqtl,starticar,endicar) 1374 integer , intent(in) :: nqtl 1375 type(TYPE_LRT_SOLUTION) , intent(in) ,dimension(size(carac)) :: listlrtsol 1376 type(TYPE_INCIDENCE_SOLUTION) , intent(in) ,dimension(size(carac)) :: listincsol 1377 integer , optional :: starticar,endicar 1378 1379 1380 integer :: ip,jm,ic,ifail,iq,i,ieff,ntlev,jef,nbtp,c,lp,effp(np),efft,s,e 1381 real (kind=dp) :: deffp,tst,prob 1382 character(len=4) :: ctest(size(pere)*20,nqtl),tail,nqtlc 1383 character(len=LEN_LINE) :: fmt1,summary,sum2,sum3 1384 1385 s=1 1386 e=ncar 1387 if ( present(starticar) ) s = starticar 1388 if ( present(endicar) ) e = endicar 1389 1390 summary="" 1391 sum2="" 1392 sum3="" 1393 nqtlc=trim(str(nqtl)) 1394 do iq=1,nqtl 1395 summary=trim(summary)//trim(str(iq-1))//" QTL versus "//trim(nqtlc)//" QTL" 1396 if (iq < nqtl) summary=trim(summary)//"," 1397 sum2=trim(sum2)//" "//trim(str(iq-1))//"/"//trim(str(nqtl))//"QTL" 1398 sum3=trim(sum3)//" Chr Pos"//trim(str(iq)) 1399 end do 1400 1401 write(unit_summary,*) 1402 write(unit_summary,*) '*************************************************************************************' 1403 write(unit_summary,*) 'Summary '//trim(summary) 1404 1405 write(unit_summary,3017)(trim(pere(ip)),ip=1,size(pere)) 1406 write(unit_summary,3018) trim(sum2)//" "//trim(sum3), & 1407 ( (' eff'//trim(str(iq)),iq=1,nqtl),' SD ', (' Student-Test'//trim(str(iq))//"(*)",iq=1,nqtl),ip=1,size(pere)) 1408 3017 format('Variable N Max Lik Pos (M) Sire', & 1409 ' ', 50(1x,a12,25x)) 1410 3018 format(14x,26a,9x,50(28a,2x)) 1411 1412 fmt1="(a8,1x,i3,"//trim(nqtlc)//"(2x,f5.1),"//trim(nqtlc)//"(2x,a5),"//trim(nqtlc)//"(2x,f5.3),7x,"//& 1413 trim(str(np))//"( "//trim(nqtlc)//"(1x,f6.3),2x,f5.3,1x,"//trim(nqtlc)//"(1x,a4)))" 1414 1415 do ic=s,e 1416 if (natureY(ic) /= 'r') cycle 1417 1418 !OFI 02/09/2010 - le calcul des effectifs est dependant du caracteres, on ajoute dans la boucle interne de ic, le calcul 1419 !et on le retire des parametres de la procedure 1420 efft = 0 1421 do ip=1,np 1422 effp(ip) = 0 1423 do jm=nmp(ip)+1,nmp(ip+1) 1424 1425 if ( ndm(jm)+1 > ndm(jm+1) ) cycle 1426 if ( ndm(jm)+1 <= 0 ) cycle 1427 1428 effp(ip) = effp(ip) + count(presentc(1,ndm(jm)+1:ndm(jm+1))) 1429 end do 1430 efft = efft + effp(ip) 1431 end do 1432 1433 ntlev=1 1434 nbtp = 3 + modele(ic,1)+modele(ic,2)!+modele(ic,3) 1435 do jef=1,modele(ic,3) 1436 ntlev=ntlev*nlev(modele(ic,nbtp+jef)) 1437 end do 1438 if ( ntlev > 1 ) then 1439 write(unit_summary,*) " .....Summary do not describe interaction*qtl effect..... : trait "//trim(carac(ic)) 1440 cycle 1441 end if 1442 1443 ctest=' ns ' 1444 c=0 1445 do ip=1,size(pere) 1446 do lp=1,ntlev 1447 c=c+1 1448 ifail=0 1449 deffp=dble(effp(ip)/2 -1) 1450 do iq=1,nqtl 1451 if ( .not. associated(listincsol(ic)%qtl_groupeName) ) then 1452 call stop_application("Devel error : ** qtl_groupeName in TYPE_INCIDENCE_SOLUTION is not initialized **") 1453 end if 1454 ieff=listincsol(ic)%qtl_groupeName(1,iq) 1455 tst=sqrt(deffp)*dabs(listincsol(ic)%paramaterValue(ieff,c)*2.d0)/listincsol(ic)%sig(1,ip) 1456 tail='U' 1457 if (deffp.ge.1.d0) then 1458 prob=MATH_QTLMAP_G01EBF(tail,tst,deffp, ifail) 1459 if(0.05.gt.prob) ctest(c,iq)='sign' 1460 else 1461 ctest(ip,iq)='na' 1462 end if 1463 end do 1464 end do 1465 end do 1466 write(unit_summary,fmt=fmt1)trim(carac(ic)),efft,(listlrtsol(ic)%lrtmax(i),i=0,nqtl-1), & 1467 (chromo(listlrtsol(ic)%chrmax(i)),i=0,nqtl-1), & 1468 (absi(listlrtsol(ic)%chrmax(i),listlrtsol(ic)%nxmax(i)),i=0,nqtl-1),& 1469 (((listincsol(ic)%paramaterValue(listincsol(ic)%qtl_groupeName(1,iq),lp),& 1470 lp=(ntlev*(ip-1))+1,ip*ntlev),iq=1,nqtl),& 1471 listincsol(ic)%sig(1,ip), & 1472 ((ctest(lp,iq),iq=1,nqtl),lp=(ntlev*(ip-1))+1,ip*ntlev),ip=1,size(pere)) 1473 1474 end do 1475 1476 write(unit_summary,*) 1477 write(unit_summary,*) 1478 write(unit_summary,*) " (*) Approximate test of the significance of the QTL effect within sire." 1479 ! close(unit_summary) 1480 1481 end subroutine print_summary_analyse
print_summary_panalyse
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_summary_panalyse
DESCRIPTION
SOURCE
297 subroutine print_summary_panalyse(n,index_key,values) 298 integer ,intent(in) :: n 299 character(len=LEN_L) ,dimension(:),intent(in) :: index_key 300 character(len=LEN_L) ,dimension(:),intent(in) :: values 301 integer :: i 302 call log_mess("",VERBOSE_DEF) 303 call log_mess("-------------------------------",VERBOSE_DEF) 304 call log_mess("********* P_ANALYSE KEYS ******",VERBOSE_DEF) 305 call log_mess("-------------------------------",VERBOSE_DEF) 306 307 write(nficout,FMT='(/,/,5x,' // & 308 '"***************** PARAMETERS ANALYSE FILE SUMMARY *****************",/)') 309 do i=1,n 310 write (nficout,FMT="(a40,'=',a)") index_key(i),values(i) 311 call log_mess("["//trim(index_key(i))//"]-->"//trim(values(i)),VERBOSE_DEF) 312 end do 313 314 end subroutine print_summary_panalyse
print_test_nuisances
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_test_nuisances
DESCRIPTION
SOURCE
1338 subroutine print_test_nuisances(ntest,listtestnuis) 1339 integer ,intent(in) :: ntest 1340 type(TEST_NUISANCES_TYPE) ,dimension(ntest),intent(in) :: listtestnuis 1341 character(len=LEN_LINE) :: fmt1,fmt2,myfmt 1342 integer :: i 1343 if ( ntest == 0 ) return 1344 1345 myfmt="(//,80('*')/'test of the effets of the model',//)" 1346 write(nficout,fmt=myfmt) 1347 myfmt="('Tested effect df. Likelihood p-value'/' ratio '/)" 1348 !header 1349 write(nficout,fmt=myfmt) 1350 1351 fmt1="(a15,'(direct effect)',1x,i5,3x,f8.3,3x,f5.3)" 1352 fmt2="(a15,' (intra qtl) ',1x,i5,3x,f8.3,3x,f5.3)" 1353 1354 do i=1,ntest 1355 if ( listtestnuis(i)%directeffect ) then 1356 write(nficout,fmt=fmt1) listtestnuis(i)%name,listtestnuis(i)%df,listtestnuis(i)%lrt,listtestnuis(i)%pvalue 1357 else 1358 write(nficout,fmt=fmt2) listtestnuis(i)%name,listtestnuis(i)%df,listtestnuis(i)%lrt,listtestnuis(i)%pvalue 1359 end if 1360 end do 1361 1362 end subroutine print_test_nuisances
print_transcriptome
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_transcriptome
DESCRIPTION
SOURCE
969 subroutine print_transcriptome(listlrtsol,listincsol) 970 type(TYPE_LRT_SOLUTION) , intent(in) ,dimension(size(carac)) :: listlrtsol 971 type(TYPE_INCIDENCE_SOLUTION) , intent(in) ,dimension(size(carac)) :: listincsol 972 973 type(TYPE_LRT_SOLUTION) :: lrtsol 974 type(TYPE_INCIDENCE_SOLUTION) :: incsol 975 character(len=LEN_LINE) :: fmt,title,likelyhood 976 integer :: ip,j,i,nbvalue,g,icar,ind,nbpos,nbProfil,iprofile 977 real (kind=dp) , dimension(:) ,allocatable :: values 978 integer , dimension(:),allocatable :: profilCar,profileNbValue 979 character(len=LEN_LINE) , dimension(:),allocatable :: profileTitle,profileFmt 980 981 982 allocate (profilCar(ncar)) 983 allocate (profileTitle(20)) ! maximum profile.... 984 allocate (profileFmt(20)) 985 allocate (profileNbValue(20)) 986 987 profilCar=0 988 nbProfil = 0 989 990 do icar=1,ncar 991 title="" 992 993 ! on compte le nombre de valeur que doit contenir le tableau de transcrit 994 ! + les position et les LRT selon l hypothese 995 nbvalue = 0 996 997 !construction du titre 998 ! on prend comme reference le premier caractere pour l'estimabilite des effets 999 do i=1,size(listincsol(icar)%groupeName) 1000 if ( .not. listincsol(icar)%eqtl_print(i) ) cycle 1001 if ( listincsol(icar)%nbParameterGroup(i) == 1 ) then 1002 title=trim(title)//"["//trim(listincsol(icar)%groupeName(i))//"] " 1003 nbvalue = nbvalue +1 1004 else 1005 title=trim(title)//"[ *"//trim(listincsol(icar)%groupeName(i))//"* " 1006 do g=1,listincsol(icar)%nbParameterGroup(i) 1007 title=trim(title)//trim(listincsol(icar)%parameterName(i,g)) 1008 if ( g < listincsol(icar)%nbParameterGroup(i) )title=trim(title)//"," 1009 nbvalue = nbvalue +1 1010 end do 1011 title=trim(title)//"] " 1012 end if 1013 end do 1014 1015 !parcours des profil pour savoir si ce profil existe deja 1016 i=1 1017 do while ( i <= nbProfil ) 1018 if ( trim(title) == profileTitle(i) ) then 1019 exit 1020 end if 1021 i=i+1 1022 end do 1023 1024 if ( i > nbProfil ) then ! ajout d un nouveau profil 1025 profileTitle(i) = trim(title) 1026 profileFmt(i) = "(1x,a20,"//trim(str(listlrtsol(1)%nqtl))//"(1x,a5,1x,f7.3)"//& 1027 trim(str(listlrtsol(1)%nqtl+nbvalue+np))//"(f7.3,1x))" 1028 profileNbValue(i) = nbvalue 1029 nbProfil = nbProfil + 1 1030 end if 1031 1032 profilCar(icar)=i 1033 end do 1034 1035 likelyhood="" 1036 1037 do i=1,listlrtsol(1)%nqtl 1038 likelyhood=trim(likelyhood)//& 1039 'Chromosome '//trim(str(i))//', QTL Position '//trim(str(i))//',' 1040 end do 1041 do i=1,listlrtsol(1)%nqtl 1042 likelyhood=trim(likelyhood)//& 1043 'H'//trim(str(i-1))//"/H"//trim(str(listlrtsol(1)%nqtl))//"," 1044 end do 1045 1046 1047 likelyhood=trim(likelyhood)//'[ *std dev *' 1048 1049 do i=1,np 1050 likelyhood=trim(likelyhood)//pere(i) 1051 if ( i< np) likelyhood=trim(likelyhood)//',' 1052 end do 1053 likelyhood=trim(likelyhood)//']' 1054 1055 1056 do iprofile=1,nbProfil 1057 1058 allocate(values(np+profileNbValue(iprofile)+3*size(absi,2))) 1059 1060 write(nficout,*) 'Profile :',iprofile 1061 write(nficout,*) 'Hypothesis :'//trim(str(listlrtsol(1)%nqtl)) 1062 write(nficout,*) 'Given parameters are respectively :' 1063 write(nficout,*) 'Gene position on the array, '//trim(likelyhood)//trim(profileTitle(iprofile)) 1064 write(nficout,*) 1065 write(nficout,*) 'note : 0.0 means not estimable ' 1066 write(nficout,*) 1067 1068 values=0.0 1069 1070 do icar=1,size(listincsol) 1071 if (profilCar(icar) /= iprofile ) cycle 1072 incsol=listincsol(icar) 1073 lrtsol=listlrtsol(icar) 1074 ind=0 1075 1076 do i=1,np 1077 ind=ind+1 1078 values(ind)=incsol%sig(1,i) 1079 end do 1080 1081 do i=1,size(listincsol(icar)%groupeName) 1082 if ( .not. listincsol(icar)%eqtl_print(i) ) cycle 1083 if ( listincsol(icar)%nbParameterGroup(i) == 1 ) then 1084 ind=ind+1 1085 if ( incsol%parameterVecsol(i,1) ) then 1086 values(ind)=incsol%paramaterValue(i,1) 1087 else 1088 values(ind)=0.d0 1089 end if 1090 else 1091 do g=1,listincsol(icar)%nbParameterGroup(i) 1092 ind=ind+1 1093 if ( incsol%parameterVecsol(i,g) ) then 1094 values(ind)=incsol%paramaterValue(i,g) 1095 else 1096 values(ind)=0.d0 1097 end if 1098 end do 1099 end if 1100 end do 1101 1102 write(nficout,FMT=profileFmt(iprofile))trim(carac(icar)),& 1103 (chromo(lrtsol%chrmax(i)),absi(lrtsol%chrmax(i),lrtsol%nxmax(i)),i=0,& 1104 lrtsol%nqtl-1),(lrtsol%lrtmax(i),i=0,lrtsol%nqtl-1),(values(i),i=1,ind) 1105 end do 1106 1107 deallocate(values) 1108 end do 1109 1110 1111 deallocate (profilCar) 1112 deallocate (profileTitle) 1113 deallocate (profileFmt) 1114 deallocate (profileNbValue) 1115 1116 end subroutine print_transcriptome
print_transcriptome_H0
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_transcriptome_H0
DESCRIPTION
SOURCE
830 subroutine print_transcriptome_H0(listincsol) 831 type(TYPE_INCIDENCE_SOLUTION) , intent(in) ,dimension(size(carac)) :: listincsol 832 833 type(TYPE_INCIDENCE_SOLUTION) :: incsol 834 character(len=LEN_LINE) :: title,likelyhood 835 integer :: ip,j,i,nbvalue,g,icar,ind,nbProfil,iprofile 836 real (kind=dp) , dimension(:) ,allocatable :: values 837 integer , dimension(:),allocatable :: profilCar,profileNbValue 838 character(len=LEN_LINE) , dimension(:),allocatable :: profileTitle,profileFmt 839 840 841 allocate (profilCar(ncar)) 842 allocate (profileTitle(20)) ! maximum profile.... 843 allocate (profileFmt(20)) 844 allocate (profileNbValue(20)) 845 846 profilCar=0 847 nbProfil = 0 848 849 do icar=1,ncar 850 nbvalue = 0 851 title="" 852 do i=1,size(listincsol(icar)%groupeName) 853 if ( .not. listincsol(icar)%eqtl_print(i) ) cycle 854 if ( listincsol(icar)%nbParameterGroup(i) == 1 ) then 855 title=trim(title)//"["//trim(listincsol(1)%groupeName(i))//"] " 856 nbvalue = nbvalue +1 857 else 858 title=trim(title)//"[ *"//trim(listincsol(1)%groupeName(i))//"* " 859 do g=1,listincsol(icar)%nbParameterGroup(i) 860 title=trim(title)//trim(listincsol(1)%parameterName(i,g)) 861 if ( g < listincsol(icar)%nbParameterGroup(i) )title=trim(title)//"," 862 nbvalue = nbvalue +1 863 end do 864 title=trim(title)//"] " 865 end if 866 end do 867 868 !parcours des profil pour savoir si ce profil existe deja 869 i=1 870 do while ( i <= nbProfil ) 871 if ( trim(title) == profileTitle(i) ) then 872 exit 873 end if 874 i=i+1 875 end do 876 877 if ( i > nbProfil ) then ! ajout d un nouveau profil 878 profileTitle(i) = trim(title) 879 profileFmt(i) = "(1x,a20,"// trim(str(nbvalue+np))//"f7.3)" 880 profileNbValue(i) = nbvalue 881 nbProfil = nbProfil + 1 882 end if 883 884 profilCar(icar)=i 885 end do 886 887 likelyhood="" 888 likelyhood=trim(likelyhood)//trim('[ *std dev *') 889 890 do i=1,np 891 likelyhood=trim(likelyhood)//trim(pere(i)) 892 if ( i< np) likelyhood=trim(likelyhood)//',' 893 end do 894 likelyhood=trim(likelyhood)//']' 895 896 do iprofile=1,nbProfil 897 898 allocate(values(np+profileNbValue(iprofile))) 899 900 write(nficout,*) 'Profile :',iprofile 901 write(nficout,*) 'Hypothesis :0' 902 write(nficout,*) 'Given parameters are respectively :' 903 write(nficout,*) 'Gene position on the array, '//trim(likelyhood)//trim(profileTitle(iprofile)) 904 write(nficout,*) 905 write(nficout,*) 'note : 0.0 means not estimable ' 906 write(nficout,*) 907 908 909 values=0.0 910 911 do icar=1,size(listincsol) 912 if (profilCar(icar) /= iprofile ) cycle 913 incsol=listincsol(icar) 914 ind=0 915 do i=1,np 916 ind=ind+1 917 values(ind)=incsol%sig(1,i) 918 end do 919 920 do i=1,size(listincsol(icar)%groupeName) 921 if ( .not. listincsol(icar)%eqtl_print(i) ) cycle 922 if ( listincsol(icar)%nbParameterGroup(i) == 1 ) then 923 ind=ind+1 924 if ( .not. associated(incsol%parameterVecsol) ) then 925 values(ind)=0.d0 926 else 927 if ( incsol%parameterVecsol(i,1) ) then 928 values(ind)=incsol%paramaterValue(i,1) 929 else 930 values(ind)=0.d0 931 end if 932 end if 933 else 934 do g=1,listincsol(icar)%nbParameterGroup(i) 935 ind=ind+1 936 if ( .not. associated(incsol%parameterVecsol) ) then 937 values(ind)=0.d0 938 else 939 if ( incsol%parameterVecsol(i,g) ) then 940 values(ind)=incsol%paramaterValue(i,g) 941 else 942 values(ind)=0.d0 943 end if 944 end if 945 end do 946 end if 947 end do 948 write(nficout,FMT=profileFmt(iprofile))trim(carac(icar)),(values(i),i=1,ind) 949 end do 950 951 deallocate(values) 952 end do 953 954 955 deallocate (profilCar) 956 deallocate (profileTitle) 957 deallocate (profileFmt) 958 deallocate (profileNbValue) 959 960 end subroutine print_transcriptome_H0
print_transcriptome_Struct_famille
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
print_transcriptome_Struct_famille
DESCRIPTION
SOURCE
1125 subroutine print_transcriptome_Struct_famille 1126 integer , dimension(:,:) , allocatable :: lestypes ! correspondance type avec lmes caracteres associe a ce type 1127 integer , dimension(:) , allocatable :: nbcarbytype ! nombre de carac dans le type 1128 logical , dimension(:,:) , allocatable :: struct_fam ! pour chaque type on stocke le profil c.a.d : presence du phenotype pour l individu kd 1129 integer :: ntype = 0 1130 character(len=LEN_L) :: listUnknown 1131 integer :: kd,ic,typ 1132 1133 allocate (lestypes (ncar,ncar)) 1134 allocate (nbcarbytype(ncar)) 1135 allocate (struct_fam (ncar,nd)) 1136 nbcarbytype=0 1137 1138 ntype=1 1139 1140 struct_fam(ntype,:)=presentc(1,:) 1141 nbcarbytype(ntype)=1 1142 lestypes(ntype,nbcarbytype(ntype))=1 1143 1144 1145 do ic=2,ncar 1146 do typ=1,ntype 1147 if ( allocated(presentc(ic,:) .EQV. struct_fam(typ,:))) then 1148 !on a trouve le meme profil 1149 nbcarbytype(typ)=nbcarbytype(typ)+1 1150 lestypes(typ,nbcarbytype(ntype))=ic 1151 exit 1152 end if 1153 end do 1154 1155 !new kind.... 1156 if (typ>ntype) then 1157 ntype=ntype+1 1158 struct_fam(ntype,:)=presentc(ic,:) 1159 nbcarbytype(ntype)=1 1160 lestypes(ntype,nbcarbytype(ntype))=ic 1161 end if 1162 end do 1163 1164 write (nficout,fmt="(2x,'TYPE',2x,'Transcript',2x,'Unknown',2x)") 1165 1166 do typ=1,ntype 1167 listUnknown='' 1168 do kd=1,nd 1169 if (.not. struct_fam(typ,kd)) then 1170 if ( trim(listUnknown) == '') then 1171 listUnknown=adjustl(animal(kd)) 1172 else 1173 listUnknown=trim(listUnknown)//','//adjustl(animal(kd)) 1174 end if 1175 end if 1176 end do 1177 write (nficout,*) typ,lestypes(typ,:nbcarbytype(ntype)),trim(listUnknown) 1178 end do 1179 1180 1181 deallocate (nbcarbytype) 1182 deallocate (struct_fam) 1183 deallocate (lestypes) 1184 1185 end subroutine print_transcriptome_Struct_famille
set_file_output
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
set_file_output
DESCRIPTION
SOURCE
273 subroutine set_file_output(active) 274 logical, intent(in) :: active 275 file = active 276 end subroutine set_file_output
set_xml_output
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
set_xml_output
DESCRIPTION
SOURCE
285 subroutine set_xml_output(active) 286 logical, intent(in) :: active 287 xml = active 288 end subroutine set_xml_output
write_simulation_file
[ Top ] [ m_qtlmap_output_handler ] [ Subroutines ]
NAME
write_simulation_file
DESCRIPTION
NOTE
SOURCE
2371 subroutine write_simulation_file(opt_qtl,is_multi,nsim,lrtsol) 2372 integer , intent(in) :: opt_qtl,nsim 2373 logical , intent(in) :: is_multi 2374 2375 type(TYPE_LRT_SOLUTION) , dimension(nsim,ncar,opt_qtl),intent(in) :: lrtsol 2376 integer, parameter :: unit_simula = 14 2377 integer :: isim,i,ic,iiq,iq,ios 2378 character(len=LEN_LINE) :: myfmt 2379 2380 if ( trim(simula)=='' ) then 2381 return 2382 end if 2383 2384 open(unit_simula,file=simula,form="formatted",recl=BUF_ALLOC_FILE,iostat=ios) 2385 if (ios/=0) then 2386 call stop_application("Can not open the file :"//trim(simula)) 2387 end if 2388 2389 2390 if (.not. is_multi ) then 2391 myfmt="(" 2392 do iq=1,opt_qtl 2393 myfmt=trim(myfmt)//"(f10.4" 2394 do iiq=1,iq 2395 myfmt=trim(myfmt)//",a5,f10.4" 2396 end do 2397 myfmt=trim(myfmt)//")" 2398 end do 2399 myfmt=trim(myfmt)//")" 2400 2401 do ic=1,ncar 2402 if (opt_qtl==1) then 2403 write(unit_simula,*) "# Trait ["//trim(carac(ic))//"] LRTMAX H0/H1 , Position CHR, Position DX " 2404 else 2405 write(unit_simula,*) "# Trait ["//trim(carac(ic))//"] LRTMAX H0/H1 , Position CHR, Position DX LRTMAX H1/H2 ,"//& 2406 " Position1 CHR, Position1 DX Position2 CHR, Position1 DX2" 2407 end if 2408 do isim=1,nsim 2409 if (.not. associated(lrtsol(isim,ic,1)%chrmax) ) cycle 2410 write(unit_simula,fmt=trim(myfmt)) & 2411 (lrtsol(isim,ic,iq)%lrtmax(iq-1),(chromo(lrtsol(isim,ic,iq)%chrmax(iiq)),& 2412 absi(lrtsol(isim,ic,iq)%chrmax(iiq),lrtsol(isim,ic,iq)%nxmax(iiq)),iiq=0,iq-1)& 2413 ,iq=1,opt_qtl) 2414 end do 2415 end do 2416 else 2417 write(unit_simula,*)"# LRTMAX , Position CHR, Position DX " 2418 do isim=1,nsim 2419 write(unit_simula,fmt='(f10.4,a5,f10.4)') & 2420 lrtsol(isim,1,1)%lrtmax(0),chromo(lrtsol(isim,1,1)%chrmax(0)),& 2421 absi(lrtsol(isim,1,1)%chrmax(0),lrtsol(isim,1,1)%nxmax(0)) 2422 end do 2423 2424 end if 2425 2426 close(unit_simula) 2427 2428 end subroutine write_simulation_file