m_qtlmap_map
NAME
m_qtlmap_map -- Map routines.
SYNOPSIS
DESCRIPTION
NOTES
SEE ALSO
MAX_SIZE_MAP
[ Top ] [ m_qtlmap_map ] [ Constants ]
NAME
MAX_SIZE_MAP
DESCRIPTION
Maximum size in Morgan allowed
mark0
[ Top ] [ m_qtlmap_map ] [ Variables ]
NAME
mark0
DESCRIPTION
maker name list read from the map file. buffer array
DIMENSIONS
number of marker read in the map file
mselec
[ Top ] [ m_qtlmap_map ] [ Variables ]
NAME
mselec
DESCRIPTION
select column value list read from the map file. buffer array
DIMENSIONS
number of marker read in the map file
posi0
[ Top ] [ m_qtlmap_map ] [ Variables ]
NAME
posi0
DESCRIPTION
average map list read from the map file. buffer array
DIMENSIONS
number of marker read in the map file
posif0
[ Top ] [ m_qtlmap_map ] [ Variables ]
NAME
posif0
DESCRIPTION
female map list read from the map file. buffer array
DIMENSIONS
number of marker read in the map file
posim0
[ Top ] [ m_qtlmap_map ] [ Variables ]
NAME
posim0
DESCRIPTION
male map list read from the map file. buffer array
DIMENSIONS
number of marker read in the map file
check_map
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
check_map
DESCRIPTION
check integrity of information
* The markers can not be overlap
* Marker have to ordered
* size map have a maximum size (MAX_SIZE_MAP)
NOTES
SOURCE
315 subroutine check_map() 316 integer :: i,c 317 real (kind=dp) :: temp 318 call log_mess('checking map......',VERBOSE_DEF) 319 320 do c=1,nchr 321 if ( (posi(c,nmk(c))-posi(c,1)) < get_long_step_morgan() ) then 322 call stop_application("The step is biggest than the consensus map [sizemap:"//& 323 trim(str(posi(c,nmk(c))-posi(c,1)))//"] [step:"//trim(str(get_long_step_morgan()))//"]") 324 end if 325 326 if ( (posim(c,nmk(c))-posim(c,1)) < get_long_step_morgan() ) then 327 call stop_application("The step is biggest than the male map [sizemap:"//& 328 trim(str(posim(c,nmk(c))-posim(c,1)))//"] [step:"//trim(str(get_long_step_morgan()))//"]") 329 end if 330 331 if ( (posif(c,nmk(c))-posif(c,1)) < get_long_step_morgan() ) then 332 call stop_application("The step is biggest than the female map [sizemap:"//& 333 trim(str(posif(c,nmk(c))-posif(c,1)))//"] [step:"//trim(str(get_long_step_morgan()))//"]") 334 end if 335 336 337 do i=2,nmk(c) 338 if (posi(c,i-1)>=posi(c,i)) then 339 call stop_application('CHR ['//chromo(c)//'] Marker ['//trim(mark(c,i-1))// & 340 '] defined in map file is greater or equal than Marker ['& 341 //trim(mark(c,i))//'] for average map') 342 end if 343 end do 344 345 do i=2,nmk(c) 346 if (posim(c,i-1)>=posim(c,i)) then 347 call stop_application('CHR ['//chromo(c)//'] Marker ['//trim(mark(c,i-1))// & 348 '] defined in map file is greater or equal than Marker ['& 349 //trim(mark(c,i))//'] for male map') 350 end if 351 end do 352 353 do i=2,nmk(c) 354 if (posif(c,i-1)>=posif(c,i)) then 355 call stop_application('CHR ['//chromo(c)//'] Marker ['//trim(mark(c,i-1))// & 356 '] defined in map file is greater or equal than Marker ['& 357 //trim(mark(c,i))//'] for female map') 358 end if 359 end do 360 !!checkin the map size 361 if ( posif(c,nmk(c))-posif(c,1) > MAX_SIZE_MAP ) then 362 temp = posif(c,nmk(c))-posif(c,1) 363 call log_mess('The map is very large : ['//trim(str(temp))//& 364 ']. The map have to be defined in Morgan!',WARNING_DEF) 365 end if 366 367 end do 368 369 call log_mess('map is checked.',VERBOSE_DEF) 370 end subroutine check_map
chromo_is_select
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
chromo_is_select
DESCRIPTION
compare the name ch with all name records in the chromo array.
INPUTS
ch : index of chromosome
RETURN
true if the chromosome is selected
NOTES
SOURCE
484 function chromo_is_select(ch) result(ind) 485 character(len=LEN_DEF) :: ch 486 integer :: ind,i 487 488 ind = 0 489 do i=1,nchr 490 if ( trim(chromo(i)) == trim(ch) ) then 491 ind = i 492 return 493 end if 494 end do 495 return 496 end function chromo_is_select
INIT_INTERNAL_MAP_STRUCTURE
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
INIT_INTERNAL_MAP_STRUCTURE
DESCRIPTION
initialize the persitents map data array :mark,posi,posim,posif,rm,rf * select only marker selected * select only marker positioned on the chromosome list : chromo
INPUTS
nb_marker : number of marker defined in the map file
NOTES
SOURCE
183 subroutine INIT_INTERNAL_MAP_STRUCTURE(nb_marker) 184 integer, intent(in) :: nb_marker 185 integer :: i,j,k,c,l1,l2,nb_marker_used,im(nchr) 186 integer :: alloc_stat,max_mark 187 real (kind=dp) :: dm,df,p,pf,pm 188 character(len=LEN_DEF) :: t 189 logical :: sort 190 integer,dimension(nchr) :: nb_marker_by_ch 191 integer,dimension(nb_marker) :: ind_chromo 192 call log_mess('SUBROUTINE INIT_INTERNAL_MAP_STRUCTURE',DEBUG_DEF) 193 194 nb_marker_by_ch=0 195 ind_chromo=0 196 do i=1,nb_marker 197 !manage only marker selectionned 198 if ( mselec(i) /= 1 ) cycle 199 ind_chromo(i)=chromo_is_select(ch(i)) 200 if ( ind_chromo(i) <= 0 ) cycle 201 nb_marker_by_ch(ind_chromo(i))=nb_marker_by_ch(ind_chromo(i))+1 202 end do 203 204 !find the greatest to allocate array to the maximum 205 max_mark=0 206 max_mark=maxval(nb_marker_by_ch) 207 208 ALLOCATE (mark(nchr,max_mark), stat = alloc_stat) 209 CALL check_allocate(alloc_stat) 210 211 ALLOCATE (posi(nchr,max_mark), stat = alloc_stat) 212 CALL check_allocate(alloc_stat) 213 214 ALLOCATE (posif(nchr,max_mark), stat = alloc_stat) 215 CALL check_allocate(alloc_stat) 216 217 ALLOCATE (posim(nchr,max_mark), stat = alloc_stat) 218 CALL check_allocate(alloc_stat) 219 nmk(:)=0 220 do c=1,nchr 221 nmk(c)=nb_marker_by_ch(c) 222 end do 223 224 im=0 225 do i=1,nb_marker 226 227 !manage only marker selectionned 228 if ( mselec(i) /= 1 ) cycle 229 ind_chromo(i)=chromo_is_select(ch(i)) 230 if ( ind_chromo(i) <= 0 ) cycle 231 im(ind_chromo(i))=im(ind_chromo(i))+1 232 call log_mess('Marker '//trim(mark0(i))//' is selectionned...',VERBOSE_DEF) 233 234 mark(ind_chromo(i),im(ind_chromo(i)))=mark0(i) 235 posi(ind_chromo(i),im(ind_chromo(i)))=posi0(i) 236 posif(ind_chromo(i),im(ind_chromo(i)))=posif0(i) 237 posim(ind_chromo(i),im(ind_chromo(i)))=posim0(i) 238 end do 239 240 deallocate(mark0) 241 deallocate(posi0) 242 deallocate(posif0) 243 deallocate(posim0) 244 deallocate(mselec) 245 !******************************* 246 ! Sort marker 247 do c=1,nchr 248 sort = .true. 249 do while ( sort ) 250 sort = .false. 251 252 if ( nmk(c) <= 0 ) then 253 call stop_application("None marker for the chromosome ["//trim(chromo(c))//"] are selectionned.") 254 end if 255 256 do i=1,nmk(c)-1 257 if ( posi(c,i) > posi(c,i+1)) then 258 sort = .true. 259 t = mark(c,i) 260 p = posi(c,i) 261 pf= posif(c,i) 262 pm= posim(c,i) 263 mark(c,i) = mark(c,i+1) 264 posi(c,i) = posi(c,i+1) 265 posif(c,i)= posif(c,i+1) 266 posim(c,i)= posim(c,i+1) 267 mark(c,i+1) = t 268 posi(c,i+1) = p 269 posif(c,i+1)= pf 270 posim(c,i+1)= pm 271 end if 272 end do 273 end do 274 end do 275 276 277 if (size(mark) == 0) then 278 call stop_application('None marker is selectionned. '// & 279 'chromosome selectionned in analyse file:') 280 endif 281 282 283 284 allocate (rm(nchr,max_mark,max_mark), stat = alloc_stat) 285 call check_allocate(alloc_stat) 286 287 allocate (rf(nchr,max_mark,max_mark), stat = alloc_stat) 288 call check_allocate(alloc_stat) 289 290 do c=1,nchr 291 do l1=1,nmk(c)-1 292 do l2=l1+1,nmk(c) 293 dm=posim(c,l2)-posim(c,l1) 294 df=posif(c,l2)-posif(c,l1) 295 rm(c,l1,l2)=xaldane(dm) 296 rf(c,l1,l2)=xaldane(df) 297 end do 298 end do 299 end do 300 call log_mess(' END SUBROUTINE INIT_INTERNAL_MAP_STRUCTURE',DEBUG_DEF) 301 end subroutine INIT_INTERNAL_MAP_STRUCTURE
read_map
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
read_map
DESCRIPTION
read the map file and fill buffer arrays mark0,posi0,posim0,posif0,mselec. This file gives the locations of the markers on the chromosome(s). Each line corresponds to a single marker, and gives (order to be followed) : * marker name (alphanumerique) ; * name of the chromosome carrying the marker (alphanumerique) ; * marker position of the marker on the average map (in Morgan) ; * marker position of the marker on the male map (in Morgan) ; * marker position of the marker on the female map (in Morgan) ; * inclusion key (=1 if the marker has to be included in the analysis, 0 if not)
NOTES
SOURCE
101 subroutine read_map 102 integer :: ios = 56 103 integer :: eof,err 104 character(len=LEN_BUFFER_WORD) :: word_token_char 105 character(len=LEN_DEF) :: word_token 106 character(len=LEN_LINE) :: line_read 107 integer :: dimArray = 0 108 integer :: alloc_stat,l0,nmark,i 109 logical :: is_ok 110 111 call log_mess('SUBROUTINE read_map',DEBUG_DEF) 112 call log_mess('reading map file...',INFO_DEF) 113 114 open(ios,file=in_carte) 115 116 ! pour savoir le nombre de ligne 117 ! read(ios,*,iostat=eof) line_read 118 eof = 0 119 do while ( eof == 0 ) 120 read(ios,*,iostat=eof) word_token_char 121 122 if ( trim(word_token_char) /= "" .and. eof == 0 ) then 123 dimArray = dimArray+1 124 endif 125 end do 126 call log_mess('number of line detected in the map file:'//trim(str(dimArray)),DEBUG_DEF) 127 128 ! Allocate array 129 ALLOCATE (mark0(dimArray), stat = alloc_stat) 130 CALL check_allocate(alloc_stat) 131 132 ALLOCATE (ch(dimArray), stat = alloc_stat) 133 CALL check_allocate(alloc_stat) 134 135 ALLOCATE (posi0(dimArray), stat = alloc_stat) 136 CALL check_allocate(alloc_stat) 137 138 ALLOCATE (posim0(dimArray), stat = alloc_stat) 139 CALL check_allocate(alloc_stat) 140 141 ALLOCATE (posif0(dimArray), stat = alloc_stat) 142 CALL check_allocate(alloc_stat) 143 144 ALLOCATE (mselec(dimArray), stat = alloc_stat) 145 CALL check_allocate(alloc_stat) 146 147 !!go to the 1rst line 148 rewind(ios) 149 150 nmark = 0 151 l0 = 0 152 eof = 0 153 do while (nmark < dimArray .and. (eof == 0) ) 154 l0 = l0+1 155 read(ios,*,IOSTAT=eof) mark0(nmark+1),ch(nmark+1),posi0(nmark+1),posim0(nmark+1),posif0(nmark+1),mselec(nmark+1) 156 if ( eof /= 0 ) THEN 157 cycle 158 end if 159 160 nmark = nmark + 1 161 162 end do 163 164 CALL INIT_INTERNAL_MAP_STRUCTURE(size(mark0)) 165 call check_map 166 call set_absi 167 call log_mess('END SUBROUTINE read_map',DEBUG_DEF) 168 end subroutine read_map
sim_carte
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
sim_carte
DESCRIPTION
INPUTS
c : index of chromosome to fill dens : density, number of marker / Morgan nalle : number of allele by marker
NOTES
Simulation d'une carte genetique et des caracteristiques des marqueurs genetiques Appele par lect_carte
SOURCE
387 subroutine sim_carte(c,dens,nalle) 388 integer , intent(in) :: c ! chromosome 389 real (kind=dp) , intent(in) :: dens 390 integer , intent(in) :: nalle 391 ! 392 integer :: il,l1,l2,i 393 real (kind=dp) :: dm,df 394 395 !*********************************************************************** 396 ! Construction de la carte 397 ! - deduit nb marqueurs de densite et taille chr 398 ! - attribue meme position des marqueurs sur cartes male et femelle 399 !*********************************************************************** 400 ! 401 ! 402 call log_mess('simulation of map...',VERBOSE_DEF) 403 404 posi(c,1)=0 405 posim(c,1)=0 406 posif(c,1)=0 407 do il=2,nmk(c) 408 posi(c,il)=posi(c,il-1)+dens 409 posim(c,il)=posim(c,il-1)+dens 410 posif(c,il)=posif(c,il-1)+dens 411 end do 412 413 ! 414 ! Initialisation des taux de recombinaison entre marqueurs 415 do l1=1,nmk(c)-1 416 do l2=l1+1,nmk(c) 417 dm=posim(c,l2)-posim(c,l1) 418 df=posif(c,l2)-posif(c,l1) 419 rm(c,l1,l2)=xaldane(dm) 420 rf(c,l1,l2)=xaldane(df) 421 end do 422 end do 423 ! 424 425 426 !************************************************************************ 427 ! Caract�ristiques des marqueurs: tous identiques 428 ! - nom des marqueurs : Mark l 429 ! - nom des all�les : 1,2... 430 ! 431 !*********************************************************************** 432 ! 433 nall=nalle 434 !manque=manq 435 !typ=1 436 437 do il=1,nmk(c) 438 do i=1,nall(c,il) 439 alleles(c,il,i)=trim(str(i)) 440 pc_all(c,il,i)=1.d2/dble(nall(c,il)) 441 end do 442 end do 443 444 end subroutine sim_carte
write_map
[ Top ] [ m_qtlmap_map ] [ Subroutines ]
NAME
write_map
DESCRIPTION
write a map file in the qtlmap format
INPUTS
file_name : name of the output file
NOTES
SOURCE
457 subroutine write_map(file_name) 458 character(len=*),intent(in) :: file_name 459 integer :: il,c 460 call log_mess('writing map file :['//file_name//']', INFO_DEF) 461 open(1,file=file_name) 462 do c=1,nchr 463 do il=1,nmk(c) 464 write(1,*) mark(c,il),c,' ',posi(c,il),posim(c,il),posif(c,il),' 1' 465 end do 466 end do 467 close(1) 468 469 end subroutine write_map