954,523 Members — Technology Publication meets Social Media
Username:
Password:
Lost login information?
Have something to say? Contribute New Article Reply to this Article

Copying from one dynamically allocated array to the other in Fortran90

Friends,

I would like to reformat a file ( fort.80) to fort.90! For that I used type constructs for reading the input ( fort.80) as well as writing it to output ( fort.90). I can successfully do copying all but one case (dihedral), where the output file looks blank ( please see the last column of fort.90). When I tried to write individually within the loop in which I copied the corresponding data (backbonedihedral) from fort.80, it works fine. But when I write the same data along with other variables (reorderedresiseqNumber,resiName, alphadistance, calphaangle), it (backbonedihedral ) gives me only blanks.( please see the wrapped code!)

Other details:

I use dynamic memory allocation for both type structures!

module internal
! first module
      type internalcoordfile ! for reading the internal variables
!        sequence
       character (len=5) :: recordName
       integer :: resiseqNumber ! to check the different residues
        character (len=3) :: resiName
       real  :: angle
       real :: distance
      end type  internalcoordfile
!  second module      
      type configurationmatrix ! stores the configuration of a protein
!        sequence
       integer reorderedresiseqNumber
       character(len=3) ::  resiName
       real calphadistance ! d
       real calphaangle ! theta
       real:: backbonedihedral ! gamma
              end type  configurationmatrix
      end module internal ! total five variables
! module ends here!!
! These two TYPES will be read by the subroutine written at the end of
! the main program!
!*****************************************************************
      program internalcoordinatematrix
        use internal
       implicit none
       character(len=80), allocatable, dimension (:) :: line
       integer :: lineNumber, ierr, i
! NOTE: insert module "internal" before the final compilation of the
! software
       type (internalcoordfile), allocatable, target :: internalmatrix(:)
        open(unit=80, file='fort.80', status='old')
      counting_linenumber: do
                             read(80,fmt='(a80)',iostat=ierr,end=10)line
                             lineNumber=lineNumber + 1
                             if (ierr.ne.0)exit
                           enddo  counting_linenumber
10       close(80)
  write(*,*)"Number of lines in the internal coordinate file", lineNumber
!     allocating  number of files from fort.80 (internal coordinates)
      allocate(internalmatrix(lineNumber))
       test_allocation: if(allocated (internalmatrix)) then
          write(*,*) "Internal file allocation is successful"
                        endif test_allocation
        open(unit=80, file='fort.80', status='old')
          do i=1,lineNumber
            read(80,'(a,1x,i4,1x,a,1x,2f12.6)')internalmatrix(i)%recordName, &
       & internalmatrix(i)%resiseqNumber,internalmatrix(i)%resiName,&
       & internalmatrix(i)%angle, internalmatrix(i)%distance !
          enddo
       close(80)
! Loop for counting line number  ends here
        !  subroutine writes out internal coordinates
      call internalout
      call readinternal(lineNumber,internalmatrix(1)%resiseqNumber)
! The following loop will count the number of residues in the file
! loop ended
      end
!******************************************************************      
      subroutine readinternal(internalfilelineNumber,matrixdimension)
      use internal
      implicit none
      integer i,j,k! loop counter
      integer, intent(in) :: internalfilelineNumber,matrixdimension
      type (internalcoordfile), allocatable, target :: internalfile(:)
! internalcoordfile is fort.80
      type(configurationmatrix), allocatable, target :: confmatrix(:)
! configuration matrix is confmatrix
      write(*,*)'number of residues',matrixdimension,'number of lines in &
     & internal files', internalfilelineNumber
!      allocate this type : internalfile
         allocate(internalfile(internalfilelineNumber))
          internalfile_allocation: if(allocated (internalfile)) then
                write(*,*) " internal file allocation is successful"
                           endif internalfile_allocation
!     allocate the type : confmatrix
         allocate(confmatrix(matrixdimension))
                confmatrix_allocation: if(allocated(confmatrix))then
               write(*,*) "conformation matrix allocation is successful"
                                       endif confmatrix_allocation
!      loop for reading lines     
      open(unit=80,file='fort.80', status='old')
       do i=1, internalfilelineNumber
!          if(trim(internalfile(i)%recordName).eq.'DIHEL') then
!           read(80,'(a,1x,i4,1x,a,1x,1f12.6)')internalfile(i)%recordName,&
!       & internalfile(i)%resiseqNumber,internalfile(i)%resiName, &
!       & internalfile(i)%dihedral
!           else if(trim(internalfile(i)%recordName).ne.'DIHEL')then
         read(80,'(a,1x,i4,1x,a,1x,2f12.6)')internalfile(i)%recordName,&
        &internalfile(i)%resiseqNumber,internalfile(i)%resiName,&
        &internalfile(i)%angle, internalfile(i)%distance ! 
!        endif
       enddo
! testing to write
         do i=1, internalfilelineNumber
!          if(trim(internalfile(i)%recordName).eq.'DIHEL') then
!           write(*,'(a,1x,i4,1x,a,1x,1f12.6)')internalfile(i)%recordName,&
!       & internalfile(i)%resiseqNumber, internalfile(i)%resiName, internalfile(i)%dihedral
!           else
         write(*,'(a,1x,i4,1x,a,1x,2f12.6)')internalfile(i)%recordName,&
        &internalfile(i)%resiseqNumber,internalfile(i)%resiName,&
        &internalfile(i)%angle, internalfile(i)%distance ! 
!        endif
       enddo
!--------------------------------------------------------------------
! COPYING RESIDUE TO CONFIGURATION MATRIX
!-------------------------------------------------------------------
!     We avoid the residue at the tails, both beginning and ending
!     So,set up the internalfile(1)%resiName='BEG'
        confmatrix(1)%resiName='BEG'
      internalloop1: do i=1, internalfilelineNumber
         if(internalfile(i)%recordName.eq.'TOTAL') cycle
          if(internalfile(i)%recordName.eq.'DIHEL')cycle
           if(internalfile(i)%recordName.eq.'SCANG')cycle
            if(internalfile(i)%recordName.eq.'SOANG')cycle
!        cycling TOTAL
     residueinternal: if(internalfile(i)%recordName.eq.'ANGLE') then
                confmatrixloop1:  do j=2,matrixdimension-1 !loop for 
                 confmatrix(j)%resiName=internalfile(j)%resiName
!                read(80,'(a,6x,a)') confmatrix(j)%resiName
!                write(90,*)confmatrix(j)%resiName
!                                  exit ! exit for the termination of the j loop                
                                  enddo confmatrixloop1
                    endif residueinternal
! We do not explicitly mention the end residue; simply write 'END'
       enddo internalloop1
          confmatrix(matrixdimension)%resiName='END'
! done!!
!------------------------------------------------------------------
!  REARRANGING RESIDUE NUMBER AND COPY TO CONFIGURATION MATRIX
!-----------------------------------------------------------------
! In this part of the program, rearranging the residue number is done
! Until this point, the residueNumber is appeared as in the original PDB
! file !!!
!    Set first residue(BEG) number as 1
       confmatrix(1)%reorderedresiseqNumber=1
!    Set final residue(END) number as the matrixdimension, that is the
!    total number of residue in the structure
       confmatrix(matrixdimension)%reorderedresiseqNumber=matrixdimension
        internalloop2: do i=1, internalfilelineNumber
         if(internalfile(i)%recordName.eq.'TOTAL') cycle
!     cycling TOTAL
      resiseqNumberinternal: if(internalfile(i)%recordName.eq.'ANGLE') then
      confmatrixloop2:  do j=2,matrixdimension-1 !loop for 
             confmatrix(j)%reorderedresiseqNumber=j
!                        write(90,*) confmatrix(j)%reorderedresiseqNumber
                        enddo confmatrixloop2
                        exit
                     endif resiseqNumberinternal
       enddo internalloop2
! Done!
!---------------------------------------------------------------------
!    COPYING CALPHA DISTANCE TO CONFIGURATION MATRIX
!---------------------------------------------------------------------
!  This snippet deals with copying the Calphadistance in the internal
!  file into the configuration matrix
!  SET first residue, (beg) : second residue value=3.88888
      confmatrix(1)%calphadistance=3.80000
! SET last residue( END) - penultimate residue length, also equal to
! 3.8000
      confmatrix(matrixdimension)%calphadistance=3.80000
      internalloop3: do i=1, internalfilelineNumber
         if(internalfile(i)%recordName.eq.'TOTAL') cycle
!     cycling TOTAL
      distanceinternal: if(internalfile(i)%recordName.eq.'ANGLE')then
      confmatrixloop3:  do j=2,matrixdimension-1 !loop for 
             confmatrix(j)%calphadistance=internalfile(j)%distance
!                        write(90,*) confmatrix(j)%calphadistance
!                        exit
                        enddo confmatrixloop3
                        exit
                     endif distanceinternal
       enddo internalloop3
! Done !
!---------------------------------------------------
! COPYING THE ANGLE TO CONFIGURATION MATRIX
!--------------------------------------------------
! This snippet deals with copying the angle in the internalfile into
! the configuration matrix
! SET Calpha angle for the first (BEG)  equal to 0.00
       confmatrix(1)%calphaangle=0.00000
        internalloop4: do i=1, internalfilelineNumber
         if(internalfile(i)%recordName.eq.'TOTAL') cycle
!     cycling TOTAL
      angleinternal: if(internalfile(i)%recordName.eq.'ANGLE')then
      confmatrixloop4:  do j=2,matrixdimension-1 !loop for 
             confmatrix(j)%calphaangle=internalfile(j)%angle
!                        write(90,*) confmatrix(j)%calphaangle
                        enddo confmatrixloop4
!                       exit ! exiting to avoid multiple writing!!
                     endif angleinternal
                      enddo internalloop4
! SET Calpha angle for the last residue (END)  equal to 0.00
       confmatrix(matrixdimension)%calphaangle=0.00000
! Done !! 
!       write(*,*) matrixdimension
  COPYING THE DIHEDRAL ANGLE To CONFIGURATION MATRIX
 <code>!----------------------------------------------------
!   This snippet deals with copying the dihedral in the internalfile
!   into the configuration matrix
!   Setting confmatrix(1) equal to 0.0
       confmatrix(1)%backbonedihedral=0.00000
       confmatrix(matrixdimension-1)%backbonedihedral=0.00000
       confmatrix(matrixdimension)%backbonedihedral=0.00000
        internalloop5: do i=1, internalfilelineNumber
         if(internalfile(i)%recordName.eq.'TOTAL') cycle
          if(internalfile(i)%recordName.eq.'ANGLE') cycle
           if(internalfile(i)%recordName.eq.'SCANG')cycle
            if(internalfile(i)%recordName.eq.'SOANG')cycle
!     cycling TOTAL, ANGLE, SCANG &amp; SOANG
      dihedralinternal: if(internalfile(i)%recordName.eq.'DIHEL')then
      confmatrixloop5:  do j=2,matrixdimension-2!loop for dihedral ! DON'T DELETE
             confmatrix(j)%backbonedihedral=internalfile(i)%angle ! the
! Value has not been stored, that is the problem !!
!            confmatrix(j)%backbonedihedral=temp
!                   internalfile(j)%angle=internalfile(i)%angle
!                  write(*,*)  internalfile(j)%angle
                 write(90,'(34x,f12.6)') confmatrix(j)%backbonedihedral
                    exit
                       enddo confmatrixloop5
                     endif dihedralinternal
       enddo internalloop5
      do j=1,matrixdimension
        write(90,'(i4,1x,a,1x,1f12.6,1x,2f12.6)') confmatrix(j)%reorderedresiseqNumber, &amp;
       &amp;  confmatrix(j)%resiName, confmatrix(j)%calphadistance,  confmatrix(j)%calphaangle, &amp;
       &amp;  confmatrix(j)%backbonedihedral

      enddo</code> 
deallocate(confmatrix)
!      deallocating internalfile
       deallocate(internalfile)
       close(80)
       end
       !  subroutine writes out internal coordinates
      subroutine internalout
      implicit none
      write(90,'(a)') '-----------------------------'
      write(90,'(a)') 'Conformation matrix of Protein backbone'
      write(90,'(a)')'-----------------------------------'
!      write(*,'(1x,a,2x,a,1x,a,1x,a,1x,a,1x,a,1x,a,1x,1a)')'Num','Res',' d',' Theta', &
!      & ' Phi', ' Dsc',' Alpha',' Omega'
      write(90,'(1x,a,1x,a,8x,a,8x,a,10x,a)')'Num','Res',' d','Theta','Phi'
       return
       end


Input fort.80

TOTAL 70
ANGLE 4 LYS 1.983920 3.822784
ANGLE 5 GLN 2.506508 3.822551
ANGLE 6 GLY 1.495086 3.821371
ANGLE 7 ARG 2.096276 3.820670
ANGLE 8 THR 2.364110 3.822508
ANGLE 9 ASP 2.094052 3.821672
ANGLE 10 CYS 1.963850 3.822539
ANGLE 11 PRO 1.677076 3.834944
ANGLE 12 ALA 1.799173 3.823198
ANGLE 13 LEU 2.063516 3.822105
ANGLE 14 PRO 1.965101 3.836382
ANGLE 15 PRO 1.949416 3.837436
ANGLE 16 GLY 1.705281 3.824572
ANGLE 17 TRP 1.892656 3.820108
ANGLE 18 LYS 2.242406 3.821930
ANGLE 19 LYS 2.308866 3.821398
ANGLE 20 GLU 2.313049 3.821454
ANGLE 21 GLU 2.083784 3.822719
ANGLE 22 VAL 2.100003 3.821506
ANGLE 23 ILE 2.052736 3.822493
ANGLE 24 ARG 1.751812 3.821769
ANGLE 25 LYS 1.626016 3.821603
ANGLE 26 SER 2.062574 3.821834
ANGLE 27 GLY 2.287319 3.824040
ANGLE 28 LEU 1.565828 3.821841
ANGLE 29 SER 1.451304 3.821571
ANGLE 30 ALA 1.934769 3.821035
ANGLE 31 GLY 1.747195 3.823237
ANGLE 32 LYS 1.926940 3.820865
ANGLE 33 SER 2.345152 3.821374
ANGLE 34 ASP 2.271087 3.821962
ANGLE 35 VAL 2.119246 3.821771
ANGLE 36 TYR 2.218048 3.821591
ANGLE 37 TYR 2.227151 3.822969
ANGLE 38 PHE 2.150835 3.821053
ANGLE 39 SER 2.169791 3.821796
ANGLE 40 PRO 1.548220 3.835462
ANGLE 41 SER 1.568206 3.823429
ANGLE 42 GLY 1.710068 3.822036
ANGLE 43 LYS 1.982734 3.822136
ANGLE 44 LYS 2.101412 3.821878
ANGLE 45 PHE 2.348185 3.821960
ANGLE 46 ARG 2.223365 3.821394
ANGLE 47 SER 2.249793 3.821801
ANGLE 48 LYS 1.592114 3.821490
ANGLE 49 PRO 1.549069 3.836537
ANGLE 50 GLN 1.674697 3.823194
ANGLE 51 LEU 1.598475 3.822194
ANGLE 52 ALA 1.579722 3.822999
ANGLE 53 ARG 1.552630 3.822948
ANGLE 54 TYR 1.618652 3.820822
ANGLE 55 LEU 1.551953 3.821788
ANGLE 56 GLY 1.941157 3.823335
ANGLE 57 ASN 1.670169 3.821963
ANGLE 58 ALA 1.670174 3.822638
ANGLE 59 VAL 2.385202 3.822763
ANGLE 60 ASP 2.025180 3.822024
ANGLE 61 LEU 1.613844 3.822328
ANGLE 62 SER 1.572482 3.821428
ANGLE 63 CYS 1.563730 3.822332
ANGLE 64 PHE 1.985124 3.822651
ANGLE 65 ASP 1.873640 3.821861
ANGLE 66 PHE 1.604218 3.822503
ANGLE 67 ARG 1.503885 3.822784
ANGLE 68 THR 1.725750 3.822031
ANGLE 69 GLY 1.684116 3.822909
ANGLE 70 LYS 2.322768 3.821630
ANGLE 71 MET 2.160215 3.821827
DIHEL 4 LYS 1.496096
DIHEL 5 GLN 1.333776
DIHEL 6 GLY 1.618819
DIHEL 7 ARG 3.022177
DIHEL 8 THR 1.924051
DIHEL 9 ASP 1.888155
DIHEL 10 CYS 2.865580
DIHEL 11 PRO 0.401756
DIHEL 12 ALA 1.320498
DIHEL 13 LEU 1.123235
DIHEL 14 PRO 1.543718
DIHEL 15 PRO 0.679356
DIHEL 16 GLY 2.250174
DIHEL 17 TRP 2.817974
DIHEL 18 LYS 3.010844
DIHEL 19 LYS 2.874462
DIHEL 20 GLU 2.587237
DIHEL 21 GLU 3.022746
DIHEL 22 VAL 2.629759
DIHEL 23 ILE 1.910234
DIHEL 24 ARG 3.043501
DIHEL 25 LYS 1.402398
DIHEL 26 SER 0.567028
DIHEL 27 GLY 1.768409
DIHEL 28 LEU 1.379249
DIHEL 29 SER 2.861548
DIHEL 30 ALA 1.259526
DIHEL 31 GLY 2.028536
DIHEL 32 LYS 3.091765
DIHEL 33 SER 2.684078
DIHEL 34 ASP 2.468847
DIHEL 35 VAL 2.898226
DIHEL 36 TYR 2.754847
DIHEL 37 TYR 2.714195
DIHEL 38 PHE 2.481630
DIHEL 39 SER 1.858816
DIHEL 40 PRO 1.072759
DIHEL 41 SER 1.911607
DIHEL 42 GLY 2.517043
DIHEL 43 LYS 2.322621
DIHEL 44 LYS 3.080138
DIHEL 45 PHE 2.650866
DIHEL 46 ARG 0.100788
DIHEL 47 SER 1.493801
DIHEL 48 LYS 1.103461
DIHEL 49 PRO 0.833585
DIHEL 50 GLN 0.718795
DIHEL 51 LEU 0.960888
DIHEL 52 ALA 0.881929
DIHEL 53 ARG 0.938154
DIHEL 54 TYR 0.788985
DIHEL 55 LEU 3.072032
DIHEL 56 GLY 0.478359
DIHEL 57 ASN 1.665880
DIHEL 58 ALA 0.289608
DIHEL 59 VAL 2.222054
DIHEL 60 ASP 3.100946
DIHEL 61 LEU 1.918940
DIHEL 62 SER 0.638466
DIHEL 63 CYS 1.665067
DIHEL 64 PHE 2.750731
DIHEL 65 ASP 3.065837
DIHEL 66 PHE 1.269825
DIHEL 67 ARG 0.177735
DIHEL 68 THR 2.174371
DIHEL 69 GLY 2.276402
DIHEL 70 LYS 2.202347

output: fort.90
----------------------

1 BEG 3.800000 0.000000 0.000000
2 LYS 3.822784 1.983920 2.202347
3 GLN 3.822551 2.506508 0.000000
4 GLY 3.821371 1.495086 0.000000
5 ARG 3.820670 2.096276 0.000000
6 THR 3.822508 2.364110 0.000000
7 ASP 3.821672 2.094052 0.000000
8 CYS 3.822539 1.963850 0.000000
9 PRO 3.834944 1.677076 0.000000
10 ALA 3.823198 1.799173 0.000000
11 LEU 3.822105 2.063516 0.000000
12 PRO 3.836382 1.965101 0.000000
13 PRO 3.837436 1.949416 0.000000
14 GLY 3.824572 1.705281 0.000000
15 TRP 3.820108 1.892656 0.000000
16 LYS 3.821930 2.242406 0.000000
17 LYS 3.821398 2.308866 0.000000
18 GLU 3.821454 2.313049 0.000000
19 GLU 3.822719 2.083784 0.000000
20 VAL 3.821506 2.100003 0.000000
21 ILE 3.822493 2.052736 0.000000
22 ARG 3.821769 1.751812 0.000000
23 LYS 3.821603 1.626016 0.000000
24 SER 3.821834 2.062574 0.000000
25 GLY 3.824040 2.287319 0.000000
26 LEU 3.821841 1.565828 0.000000
27 SER 3.821571 1.451304 0.000000
28 ALA 3.821035 1.934769 0.000000
29 GLY 3.823237 1.747195 0.000000
30 LYS 3.820865 1.926940 0.000000
31 SER 3.821374 2.345152 0.000000
32 ASP 3.821962 2.271087 0.000000
33 VAL 3.821771 2.119246 0.000000
34 TYR 3.821591 2.218048 0.000000
35 TYR 3.822969 2.227151 0.000000
36 PHE 3.821053 2.150835 0.000000
37 SER 3.821796 2.169791 0.000000
38 PRO 3.835462 1.548220 0.000000
39 SER 3.823429 1.568206 0.000000
40 GLY 3.822036 1.710068 0.000000
41 LYS 3.822136 1.982734 0.000000
42 LYS 3.821878 2.101412 0.000000
43 PHE 3.821960 2.348185 0.000000
44 ARG 3.821394 2.223365 0.000000
45 SER 3.821801 2.249793 0.000000
46 LYS 3.821490 1.592114 0.000000
47 PRO 3.836537 1.549069 0.000000
48 GLN 3.823194 1.674697 0.000000
49 LEU 3.822194 1.598475 0.000000
50 ALA 3.822999 1.579722 0.000000
51 ARG 3.822948 1.552630 0.000000
52 TYR 3.820822 1.618652 0.000000
53 LEU 3.821788 1.551953 0.000000
54 GLY 3.823335 1.941157 0.000000
55 ASN 3.821963 1.670169 0.000000
56 ALA 3.822638 1.670174 0.000000
57 VAL 3.822763 2.385202 0.000000
58 ASP 3.822024 2.025180 0.000000
59 LEU 3.822328 1.613844 0.000000
60 SER 3.821428 1.572482 0.000000
61 CYS 3.822332 1.563730 0.000000
62 PHE 3.822651 1.985124 0.000000
63 ASP 3.821861 1.873640 0.000000
64 PHE 3.822503 1.604218 0.000000
65 ARG 3.822784 1.503885 0.000000
66 THR 3.822031 1.725750 0.000000
67 GLY 3.822909 1.684116 0.000000
68 LYS 3.821630 2.322768 0.000000
69 MET 3.821827 2.160215 0.000000
70 END 3.800000 0.000000 0.000000

jmandumpal
Newbie Poster
2 posts since Sep 2008
Reputation Points: 17
Solved Threads: 0
 

I got the program correct:

What I did is that remove the innerloop5 and insert a variable and incremented with every iteration of internalloop5

internalloop5: do i=1, internalfilelineNumber
....................
dihedralinternal: if(internalfile(i)%recordName.eq.'DIHEL')then
.....................................
confmatrix(j)%backbonedihedral=internalfile(i)%angle ! the
! Value has not been stored, that is the problem !!
! confmatrix(j)%backbonedihedral=temp
! internalfile(j)%angle=internalfile(i)%angle
! write(*,*) internalfile(j)%angle
write(90,'(34x,f12.6)') confmatrix(j)%backbonedihedral
exit
enddo confmatrixloop5
endif dihedralinternal
enddo internalloop5

replaced by
confmatrix(1)%backbonedihedral=0.0000 !
confmatrix(matrixdimension-1)%backbonedihedral=0.0000 !
confmatrix(matrixdimension)%backbonedihedral=0.0000 !
j=2
internalloop5: do i=1, internalfilelineNumber
dihedralinternal: if(internalfile(i)%recordName.eq.'DIHEL')then
confmatrix(j)%backbonedihedral=internalfile(i)%angle !
j=j+1
endif dihedralinternal
enddo internalloop5
do j=1,matrixdimension
write(90,'(i4,1x,a,1x,1f12.6,1x,2f12.6)') confmatrix(j)%reorderedresiseqNumber, &
& confmatrix(j)%resiName, confmatrix(j)%calphadistance, confmatrix(j)%calphaangle, &
& confmatrix(j)%backbonedihedral
enddo

jmandumpal
Newbie Poster
2 posts since Sep 2008
Reputation Points: 17
Solved Threads: 0
 

This article has been dead for over three months

Post: Markdown Syntax: Formatting Help
You
View similar articles that have also been tagged: