proprietes.F90 19.6 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
!!-------------------------------------------------------
!!---- Relaxed Selected Excitation (RelaxSE)
!!-------------------------------------------------------
!!---- This file is part of RelaxSE
!!---- 
!!---- The RelaxSE project is distributed under LGPL. In agreement with the
!!---- Intergovernmental Convention of the ILL, this software cannot be used
!!---- in military applications.
!!---- 
!!---- Copyright (C) 2016-2021  Institut Laue-Langevin (ILL), Grenoble, FRANCE
!!----                          Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
!!---- 
!!---- Authors: Elisa REBOLINI (ILL)             rebolini@ill.fr
!!----          Marie-Bernadette LEPETIT (CNRS)  Marie-Bernadette.Lepetit@neel.cnrs.fr
!!---- 
!!---- RelaxSE is free software; you can redistribute it and/or
!!---- modify it under the terms of the GNU Lesser General Public
!!---- License as published by the Free Software Foundation; either
!!---- version 3.0 of the License, or (at your option) any later version.
!!---- 
!!---- RelaxSE is distributed in the hope that it will be useful,
!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!!---- Lesser General Public License for more details.
!!---- 
!!---- You should have received a copy of the GNU Lesser General Public
!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
!!---- 


!$====================================================================
!> @brief Projection of states on the CAS determinants
!> @author MBL
!> @date Mai 2020
!
!> @param[in] psi(ndet,nvec) = states matrix
!> @param[in] Ener(nvec)    = eigenvalues
!> @param[in] ndet = number of determinants
!> @param[in] nvec = number of vectors
!> @param[in] nvec = number of active electrons
!> @param[in] iunit : output file
!$====================================================================

subroutine cass_proj(psi, ener, ndet, nvec, nelact, det, &
     det_info, o_info, nblock, shtblkdet,nblkdet,deter_index,iunit)
  use dimensions
  use info
  use typedet
  use utils 
  use utils_wrt
  
  implicit none
  Integer (KIND=kd_int),        intent(in) :: ndet, nvec, nblock, nelact, iunit
  type(det_infotype),           intent(in) :: det_info
  type(o_infotype),             intent(in) :: o_info
  type(deter), dimension(ndet), intent(in) :: det
  Integer, dimension(nblock),   intent(in) :: shtblkdet, nblkdet, deter_index
  real(kd_dble), dimension(ndet,nvec), intent(in) :: psi
  real(kd_dble), dimension(nvec),      intent(in) :: ener
  !real(kd_dble), dimension(:), allocatable ::  psi_S
  integer, parameter :: pas = 10
  character*1, parameter :: A1=" " 
  
  real(kd_dble), dimension(nvec) :: normevec
  integer :: nd00, shift, nact
  integer :: idet, ivec, nq, nr, i, iwr

 
  ! bloc D00 (1er bloc)
  if (deter_index(1).ne.00) return

  nact = o_info%nact
  
  normevec(:) = 0.d0
  shift       = shtblkdet(1)
  do ivec = 1,nvec
     do idet = 1, nblkdet(1)
        normevec(ivec) = normevec(ivec) + psi(idet+shift,ivec)*psi(idet+shift,ivec)
     end do
  end do

  ! allocate(psi_S(nvec))
  ! psi_S(:) = 0.d0
  !call s2(psi,psi_S,ndet,nvec,nelact, det, det_info,o_info, iunit)
  
  nq=nvec/10
  nr=nvec - nq*pas
  do i =1,nq
     write(iunit,'(" Vect ")',advance='no')
     do iwr = 1, max(2*nact +1-6,0)
        write(iunit,'(a1)',advance='no') A1
     end do
     write(iunit,9010) (ivec, ivec=(i-1)*pas+1,i*pas)

     write(iunit,'(" Ener ")',advance='no')
     do iwr = 1, max(2*nact +1-6,0)
        write(iunit,'(a1)',advance='no') A1
     end do
     write(iunit,9012) ener((i-1)*pas+1:i*pas)

     write(iunit,'(" Pcas ")',advance='no')
     do iwr = 1, max(2*nact +1-6,0)
        write(iunit,'(a1)',advance='no') A1
     end do
     write(iunit,9012) normevec((i-1)*pas+1:i*pas)

     ! write(iunit,'(" S    ")',advance='no')
     ! do iwr = 1, max(2*nact +1-6,0)
     !    write(iunit,'(a1)',advance='no') A1
     ! end do
     ! write(iunit,9012) psi_S((i-1)*pas+1:i*pas)
     
     write(iunit,*)
     do idet = 1, nblkdet(1)
        call  wrtact(det(idet)%detact, f_output, .true., o_info%nact)  
        do iwr = 1,6 - (2*nact +1)
           write(iunit,'(a1)',advance='no') A1
        end do
        write(iunit,9012) psi(idet,(i-1)*pas+1:i*pas)
     end do
     write(iunit,*)
     write(iunit,*)
  end do


  
  if (nr.eq.0) return
  write(iunit,'(" Vect ")',advance='no')
  do iwr = 1, max(2*nact +1-6,0)
     write(iunit,'(a1)',advance='no') A1
  end do
  write(iunit,9010) (ivec, ivec=nq*pas+1,nvec)
  
  write(iunit,'(" Ener ")',advance='no')
  do iwr = 1, max(2*nact +1-6,0)
     write(iunit,'(a1)',advance='no') A1
  end do
  write(iunit,9012)     ener(nq*pas+1:nvec)
  
  write(iunit,'(" Pcas ")',advance='no')
  do iwr = 1, max(2*nact +1-6,0)
     write(iunit,'(a1)',advance='no') A1
  end do
  write(iunit,9012) normevec(nq*pas+1:nvec)
  
   ! write(iunit,'(" S    ")',advance='no')
   ! do iwr = 1, max(2*nact +1-6,0)
   !    write(iunit,'(a1)',advance='no') A1
   ! end do
   ! write(iunit,9012) psi_S(nq*pas+1:nvec)
   
   write(iunit,*)
   do idet = 1, nblkdet(1)
      call  wrtact(det(idet)%detact, f_output, .true., o_info%nact)  
      do iwr = 1,6 - (2*nact +1)
         write(iunit,'(a1)',advance='no') A1
      end do
      write(iunit,9012)     psi(idet,nq*pas+1:nvec)
   end do

  ! deallocate(psi_S)


9010 format(10(10x,I4,6x))
9012 format(10(F18.8,2x))

end subroutine cass_proj

!$====================================================================
!> @brief <Psi|S^2|psi>
!> @author MBL
!> @date Mai 2020
!
!> @param[in] psi(ndet,nvec) = states matrix
!> @param[in] ndet = number of determinants
!> @param[in] nvec = number of vectors
!> @param[in] nvec = number of active electrons
!> @param[in] iunit : output file
!$====================================================================
subroutine s2(psi,psi_S,ndet,nvec, nelact, det, det_info, d, o_info, iunit)
  use dimensions
  use info
  use typedet
  use utils 
  use utils_wrt
  
  implicit none
  !Logical, parameter :: ldebug=.false.
  Integer (KIND=kd_int),        intent(in) :: ndet, nvec, nelact, iunit
  type(det_infotype),           intent(in) :: det_info
  type(o_infotype),             intent(in) :: o_info
  type(deter), dimension(ndet), intent(in) :: det
  real(kd_dble), dimension(ndet,nvec), intent(in) :: psi
  Real(kd_dble), dimension(nvec),     intent(inout) :: psi_S
  type(deter_dblocklist) :: d

  Integer(KIND=kd_int)                     :: nact
  type(deter), dimension(:),   allocatable :: SmdetI, SmdetJ, SpdetI, SpdetJ
  Integer,     dimension(:),   allocatable :: signdetI, signdetJ
  type(deter), dimension(:,:), allocatable :: SMat
  Integer,     dimension(:,:), allocatable :: SSignMat
  integer (Kind= kindTP), dimension(2)     :: trous, part
  Real(kd_dble), dimension(nvec)           :: psi_S2
  
  Integer :: ivec, idet, jdet, kdet,  shtrous, shpart, &
       nmoinsI, nmoinsJ, nplusI, nplusJ
  Integer :: i,j, itmp

  real(kd_dble) :: t1, t2, t3, t4, t5, t6, wt1, wt2, wt3, wt4, wt5, wt6

  nact =  o_info%nact
  psi_S2(:) = 0.d0

  shtrous = 2*o_info%ngel +   o_info%nocc +   o_info%nligo
  shpart  = 2*o_info%ngel + 2*o_info%nocc + 2*o_info%nligo &
       +    2*o_info%nact &
       +      o_info%nligv +  o_info%nvirt


  allocate(SSignMat(0:nelact+4,ndet),SMat(nelact+4,ndet))
  
!!$--- Sz Sz
  !$OMP PARALLEL DEFAULT(SHARED) &
  !$OMP& PRIVATE(ivec, idet, jdet, kdet, itmp, i, j, SmdetI, SmdetJ, SpdetI, SpdetJ), &
  !$OMP& PRIVATE(signdetI, signdetJ, nmoinsI, nmoinsJ, nplusI, nplusJ)

  !$OMP MASTER
  call gettime(t1,wt1)
  !$OMP END MASTER
  
  !$OMP DO reduction(+:psi_S2)
  do idet = 1,ndet
     itmp = 0
     call sz_det(det(idet),itmp,o_info,shtrous, shpart)
     do ivec = 1,nvec
        psi_S2(ivec) =  psi_S2(ivec) + 0.25d0*psi(idet,ivec)*dble(itmp*itmp)*psi(idet,ivec)
     end do
  end do
  !$OMP END DO

  !$OMP MASTER
  call gettime(t2,wt2)
  write(f_output,*) ' >>> Sz Sz in',wt2-wt1,'second(s)'
  ! write(f_output,*) " Apres SzSz =",psi_S2
  flush(f_output)
  !$OMP END MASTER
     
!!$--- S+ S-
  !$OMP MASTER
  write(f_output,*) " alllocate 1"
  flush(f_output)
  !$OMP END MASTER
  !  if (ldebug)   write(f_output,*) " 1/2 <I|S+S-|I> = 1/2 <(S-) I | (S-) I>"
  !$OMP DO reduction(+:psi_S2)
  do idet = 1,ndet
     call smoins_det(det(idet),SmdetI,signdetI,nmoinsI, o_info, shtrous, shpart)
     SSignMat(0,idet)         = nmoinsI
     SSignMat(1:nmoinsI,idet) = signdetI(1:nmoinsI)
     SMat(1:nmoinsI,idet)     = SmdetI(1:nmoinsI)
     do ivec = 1,nvec
        psi_S2(ivec) =  psi_S2(ivec) + 0.5d0*psi(idet,ivec)*dble(nmoinsI)*psi(idet,ivec)
     end do
     deallocate (SmdetI,signdetI)
  end do
  !&OMP END DO
  
  !$OMP MASTER
  call gettime(t3,wt3)
  write(f_output,*) ' >>> 1/2 <I|S+S-|I> in',wt3-wt2,'second(s)'
  ! write(f_output,*) " Diag  S+S- =",psi_S2
  flush(f_output)
  !$OMP END MASTER
  

  ! if (ldebug) write(f_output,*) " 1/2 <I|S+S-|J> = 1/2 <(S-) I | (S-) J>"
  !$OMP DO reduction(+:psi_S2)
  do jdet = 1,ndet
     ! call smoins_det(det(jdet),SmdetJ, signdetJ, nmoinsJ, o_info, shtrous, shpart)
     do idet = 1,jdet-1
        ! call smoins_det(det(idet),SmdetI, signdetI, nmoinsI, o_info, shtrous, shpart)
        itmp = 0
        ! do j=1,nmoinsJ
        !    do i=1,nmoinsI
        !       if (eq_det(SmdetJ(j),SmdetI(i))) then
        !          itmp = itmp + signdetJ(j)*signdetI(i)
        !       end if
        !    end do
        ! end do
        do j = 1, SSignMat(0,jdet)
           do i = 1, SSignMat(0,idet)
              if (eq_det(SMat(j,jdet),SMat(i,idet))) &
                   itmp = itmp + SSignMat(j,jdet)*SSignMat(i,idet)
           end do
        end do
        do ivec = 1,nvec
           psi_S2(ivec) =  psi_S2(ivec) + psi(idet,ivec)*dble(itmp)*psi(jdet,ivec)
        end do        
        ! deallocate (SmdetI,signdetI)
     end do
     ! deallocate (SmdetJ,signdetJ)
  end do
  !&OMP END DO
  
  !$OMP MASTER
  call gettime(t4,wt4)
  write(f_output,*) ' >>> 1/2 <I|S+S-|J> in',wt4-wt3,'second(s)'
  ! write(f_output,*) " Ediag S+S- =",psi_S2
  flush(f_output)
  !$OMP END MASTER
     
!!$--- S- S+
  !  if (ldebug) write(f_output,*) " 1/2 <I|S-S+|I> = 1/2 <(S+) I | (S+) I>"
  !$OMP DO reduction(+:psi_S2)
  do idet = 1,ndet
     call splus_det(det(idet),SpdetI, signdetI, nplusI, o_info, shtrous, shpart)
     SSignMat(0,idet)         = nplusI
     SSignMat(1:nplusI,idet) = signdetI(1:nplusI)
     SMat(1:nplusI,idet)     = SpdetI(1:nplusI)
     do ivec = 1,nvec
        psi_S2(ivec) =  psi_S2(ivec) + 0.5d0*psi(idet,ivec)*dble(nplusI)*psi(idet,ivec)
     end do
     deallocate (SpdetI,signdetI)
  end do
  !&OMP END DO
  !$OMP MASTER
  call gettime(t5,wt5)
  write(f_output,*) ' >>> 1/2 <I|S-S+|I> in',wt5-wt4,'second(s)'
  !  write(f_output,*) " Diag  S-S+ =",psi_S2
  flush(f_output)
  !$OMP END MASTER
  
  !  if (ldebug) write(f_output,*) " 1/2 <I|S-S+|J> = 1/2 <(S+) I | (S+) J>"
  !$OMP DO reduction(+:psi_S2)
  do jdet = 1,ndet
     ! call splus_det(det(jdet),SpdetJ, signdetJ, nplusJ, o_info, shtrous, shpart)
     do idet = 1,jdet-1
        ! call splus_det(det(idet),SpdetI, signdetI, nplusI, o_info, shtrous, shpart)
        itmp = 0
        ! do j=1,nplusJ
        !    do i=1,nplusI
        !       if (eq_det(SpdetJ(j),SpdetI(i))) itmp = itmp +  signdetJ(j)*signdetI(i)
        !    end do
        ! end do
        do j = 1, SSignMat(0,jdet)
           do i = 1, SSignMat(0,idet)
              if (eq_det(SMat(j,jdet),SMat(i,idet))) then
                 itmp = itmp + SSignMat(j,jdet)*SSignMat(i,idet)
              end if
           end do
        end do
        do ivec = 1,nvec
           psi_S2(ivec) =  psi_S2(ivec) + psi(idet,ivec)*dble(itmp)*psi(jdet,ivec)
        end do
        ! deallocate (SpdetI,signdetI)
     end do
     ! deallocate (SpdetJ,signdetJ)
  end do
  !&OMP END DO
  
  !$OMP MASTER
  call gettime(t6,wt6)
  write(f_output,*) ' >>> 1/2 <I|S-S+|J> in',wt6-wt5,'second(s)'
  ! write(f_output,*) " Ediag S-S+ =",psi_S2
  write(f_output,*)
  flush(f_output)
  !$OMP END MASTER

  !$OMP END PARALLEL
  deallocate(SSignMat,SMat)
  
  do ivec = 1,nvec
     psi_S(ivec) = 0.5d0*(-1.d0+sqrt(1.d0+4.d0*psi_S2(ivec)))
  end do
  !if (ldebug)
  ! write(f_output,9002) psi_S2(1:nvec)
376
  !9002 format(" S2   ",10(2x,F18.8))
377
378
 
end subroutine s2
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592


!$====================================================================
!> @brief Print WF contributions larger than seuilcoef
!> @author MBL
!> @date April 2022
!
!> @param[in] vect(ndet,nvec) = states matrix
!> @param[in] det(ndet) = determinants
!> @param[in] ndet = number of determinants
!> @param[in] nvec = number of vectors
!> @param[in] nvec = seuilcoef printing threshold 
!> @param[in] iunit : output file
!$====================================================================
  Subroutine  largecoef(seuilcoef,ndet,nvec,det,vect,o_info,iunit)
    ! -------- Donnes globales -----------------------------------
    use dimensions
    use info
    use files
    use utils_char
    use typedet
    use spindetact
    Implicit none
    ! -------- Donnes transmises -----------------------------------
    Integer (KIND=kd_int), intent(in) :: ndet,nvec, iunit
    Real (KIND=kd_dble),   intent(in) :: seuilcoef
    Real (KIND=kd_dble), dimension(ndet,nvec), intent(in) :: vect
    type(deter), dimension(ndet), intent(in) :: det
    type(o_infotype), intent(in)             :: o_info
    
    !   -------- Donnes locales -----------------------------------
    Integer, parameter :: pas = 5
    Integer (KIND=kd_int) :: npas, kpas
    Integer (KIND=kd_int) :: shtrou, shpart, shtu, shtd, shpu, shpd
    Integer (KIND=kd_int) :: idet, ivec, ibit, j
    Logical :: OK
    Character*1, dimension(2) :: spin
    Integer(KIND=kd_int), dimension(2) :: sh

    !============================================================
    ! -------- Code ---------------------------------------------
    !-----
    !----- Initialisations 
    !-----
    npas = nvec/pas

    shtrou  = 2*o_info%ngel +  o_info%nocc + o_info%nligo
    shtu    = o_info%ngel
    shtd    = o_info%ngel +  o_info%nocc + o_info%nligo
    shpart  = 2*(o_info%ngel +  o_info%nocc + o_info%nligo + o_info%nact) + o_info%nligv + o_info%nvirt
    shpu    = o_info%ngel + o_info%nocc + o_info%nligo + o_info%nact
    shpd    = o_info%ngel + o_info%nocc + o_info%nligo + o_info%nact + o_info%nligv + o_info%nvirt

    if (npas.eq.0) goto 10
    kp : do kpas = 1,npas
       do idet = 1, ndet
          ! test seuil
          OK = .false.
          do ivec =1,nvec
             if (abs(vect(idet,ivec)).gt.seuilcoef) OK=.true.
          end do
          if (.not.OK) cycle
          ! OK = .true. => write det
          write(iunit,'(i9,2x)',advance='no') idet
          ! actives
          do ibit = 0,o_info%nact-1
             write(iunit,'(i1)',advance='no') ibits(det(idet)%detact, ibit, 1)
          end do
          write(iunit,'(" ")',advance='no')
          do ibit = o_info%nact, 2*o_info%nact-1
             write(iunit,'(i1)',advance='no') ibits(det(idet)%detact, ibit, 1)
          end do
          write(iunit,'(" ")',advance='no')
          ! trous
          if (det(idet)%dettr(1).eq.0) then ! 0 trou
             write(iunit,'(11x," -> ")',advance='no')
          else if (det(idet)%dettr(2).eq.0) then ! 1 trou
             if (det(idet)%dettr(1).le.shtrou) then
                spin(1)="u"
                sh(1)  = shtu
             else
                spin(1)="d"
                sh(1)  = shtd
             end if
             write(iunit,'(I4,a1,6x," -> ")',advance='no') det(idet)%dettr(1)-sh(1), spin(1)
          else ! 2 trou
             if (det(idet)%dettr(1).le.shtrou) then
                spin(:)="u"
                sh(:)  = shtu
             else if (det(idet)%dettr(2).le.shtrou) then
                spin(1)="d"
                sh(1)  = shtd
                spin(2)="u"
                sh(2)  = shtu
             else
                spin(:)="d"
                sh(:)  = shtd
             end if
             write(iunit,'(I4,a1,I4,a1,1x," -> ")',advance='no') (det(idet)%dettr(j)-sh(j), spin(j), j=2,1,-1)
          end if
          ! particules
          if (det(idet)%detprt(1).eq.0) then ! 0 particules
             write(iunit,'(11x,2x)',advance='no')
          else if (det(idet)%detprt(2).eq.0) then ! 1 particules
             if (det(idet)%detprt(1).le.shpart) then
                spin(1)="u"
                sh(1)  = shpu
             else
                spin(1)="d"
                sh(1)  = shpd
             end if
             write(iunit,'(I4,a1,6x,2x)',advance='no') det(idet)%detprt(1)-sh(1), spin(1)
          else ! 2 particules
             if (det(idet)%detprt(2).le.shpart) then
                spin(:)="u"
                sh(:)  = shpu
             else if (det(idet)%detprt(1).le.shpart) then
                spin(1)="u"
                sh(1)  = shpu
                spin(2)="d"
                sh(2)  = shpd
             else
                spin(:)="d"
                sh(:)  = shpd
             end if
             write(iunit,'(I4,a1,I4,a1,3x)',advance='no') (det(idet)%detprt(j)-sh(j), spin(j), j=1,2)
          end if
          ! vecteur
          write(iunit,9990)  (vect(idet,ivec), ivec = 1 + (kpas-1)*pas, 1 + kpas*pas)
       end do
       write(iunit,*)
    end do kp
    
10  if (mod(nvec,pas) .eq. 0) return
    do idet = 1, ndet
       ! test seuil
       OK = .false.
       do ivec =1,nvec
          if (abs(vect(idet,ivec)).gt.seuilcoef) OK=.true.
       end do
       if (.not.OK) cycle
       ! OK = .true. => write det
       write(iunit,'(i9,2x)',advance='no') idet
       ! actives
       do ibit = 0,o_info%nact-1
          write(iunit,'(i1)',advance='no') ibits(det(idet)%detact, ibit, 1)
       end do
       write(iunit,'(" ")',advance='no')
       do ibit = o_info%nact, 2*o_info%nact-1
          write(iunit,'(i1)',advance='no') ibits(det(idet)%detact, ibit, 1)
       end do
       write(iunit,'(" ")',advance='no')
       ! trous
       if (det(idet)%dettr(1).eq.0) then ! 0 trou
          write(iunit,'(11x," -> ")',advance='no')
       else if (det(idet)%dettr(2).eq.0) then ! 1 trou
          if (det(idet)%dettr(1).le.shtrou) then
             spin(1)="u"
             sh(1)  = shtu
          else
             spin(1)="d"
             sh(1)  = shtd
          end if
          write(iunit,'(I4,a1,6x," -> ")',advance='no') det(idet)%dettr(1)-sh(1), spin(1)
       else ! 2 trou
          if (det(idet)%dettr(1).le.shtrou) then
             spin(:)="u"
             sh(:)  = shtu
          else if (det(idet)%dettr(2).le.shtrou) then
             spin(1)="d"
             sh(1)  = shtd
             spin(2)="u"
             sh(2)  = shtu
          else
             spin(:)="d"
             sh(:)  = shtd
          end if
          write(iunit,'(I4,a1,I4,a1,1x," -> ")',advance='no') (det(idet)%dettr(j)-sh(j), spin(j), j=2,1,-1)
       end if
       ! particules
       if (det(idet)%detprt(1).eq.0) then ! 0 particules
          write(iunit,'(11x,2x)',advance='no')
       else if (det(idet)%detprt(2).eq.0) then ! 1 particules
          if (det(idet)%detprt(1).le.shpart) then
             spin(1)="u"
             sh(1)  = shpu
          else
             spin(1)="d"
             sh(1)  = shpd
          end if
          write(iunit,'(I4,a1,6x,2x)',advance='no') det(idet)%detprt(1)-sh(1), spin(1)
       else ! 2 particules
          if (det(idet)%detprt(2).le.shpart) then
             spin(:)="u"
             sh(:)  = shpu
          else if (det(idet)%detprt(1).le.shpart) then
             spin(1)="u"
             sh(1)  = shpu
             spin(2)="d"
             sh(2)  = shpd
          else
             spin(:)="d"
             sh(:)  = shpd
          end if
          write(iunit,'(I4,a1,I4,a1,3x)',advance='no') (det(idet)%detprt(j)-sh(j), spin(j), j=1,2)
       end if
       ! vecteur
       write(iunit,9990)  (vect(idet,ivec), ivec = 1 + npas*pas, nvec )
    end do
    write(iunit,*)
    
9990 format(5(2x,F20.16))

  end Subroutine largecoef