cmake pgf90
[unres.git] / source / cluster / wham / src / read_coords.F
index 2a21cbe..61fbbc9 100644 (file)
@@ -129,7 +129,7 @@ C
    13 NCON=ICON-1
 
 #endif
-      call flush(iout)
+c      call flush(iout)
       jj_old=1
       open (icbase,file=bprotfiles,status="unknown",
      &   form="unformatted",access="direct",recl=lenrec)
@@ -162,7 +162,11 @@ c through a ring.
           if (iret.eq.0) then
             write (iout,*) "Error: coordinate file ",
      &       intinname(:ilen(intinname))," does not exist."
-            call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #ifdef MPI
             call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
 #endif
@@ -170,7 +174,11 @@ c through a ring.
           endif
         else
           write (iout,*) "Error: coordinate format not specified"
-          call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #ifdef MPI
           call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
 #else
@@ -178,13 +186,15 @@ c through a ring.
 #endif
         endif
 
-#define DEBUG
 #ifdef DEBUG
         write (iout,*) "Opening file ",intinname(:ilen(intinname))
         write (iout,*) "lenrec",lenrec_in
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #endif
-#undef DEBUG
 c        write (iout,*) "maxconf",maxconf
         i=0
         do while (.true.)
@@ -212,16 +222,26 @@ c          call flush(iout)
                enddo
              enddo
           else
+            itmp=0
 #if (defined(AIX) && !defined(JUBL))
             call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret)
             if (iret.eq.0) goto 101
             call xdrfint_(ixdrf, nss, iret)
             if (iret.eq.0) goto 101
             do j=1,nss
-              call xdrfint_(ixdrf, ihpb(j), iret)
-              if (iret.eq.0) goto 101
-              call xdrfint_(ixdrf, jhpb(j), iret)
-              if (iret.eq.0) goto 101
+cc              if (dyn_ss) then
+cc                call xdrfint_(ixdrf, idssb(j), iret)
+cc                if (iret.eq.0) goto 101
+cc                call xdrfint_(ixdrf, jdssb(j), iret)
+cc                if (iret.eq.0) goto 101
+cc             idssb(j)=idssb(j)-nres
+cc             jdssb(j)=jdssb(j)-nres
+cc              else
+                call xdrfint_(ixdrf, ihpb(j), iret)
+                if (iret.eq.0) goto 101
+                call xdrfint_(ixdrf, jhpb(j), iret)
+                if (iret.eq.0) goto 101
+cc              endif
             enddo
             call xdrffloat_(ixdrf,reini,iret)
             if (iret.eq.0) goto 101
@@ -240,13 +260,23 @@ c            call flush(iout)
             call xdrfint(ixdrf, nss, iret)
 c            write (iout,*) "iret",iret
 c            write (iout,*) "nss",nss
-            call flush(iout)
+c            call flush(iout)
             if (iret.eq.0) goto 101
             do k=1,nss
-              call xdrfint(ixdrf, ihpb(k), iret)
-              if (iret.eq.0) goto 101
-              call xdrfint(ixdrf, jhpb(k), iret)
-              if (iret.eq.0) goto 101
+cc              if (dyn_ss) then
+cc                call xdrfint(ixdrf, idssb(k), iret)
+cc                if (iret.eq.0) goto 101
+cc               call xdrfint(ixdrf, jdssb(k), iret)
+cc                if (iret.eq.0) goto 101
+cc                idssb(k)=idssb(k)-nres
+cc                jdssb(k)=jdssb(k)-nres
+cc              write(iout,*) "TUTU", idssb(k),jdssb(k)
+cc              else
+                call xdrfint(ixdrf, ihpb(k), iret)
+                if (iret.eq.0) goto 101
+                call xdrfint(ixdrf, jhpb(k), iret)
+                if (iret.eq.0) goto 101
+cc              endif
             enddo
             call xdrffloat(ixdrf,reini,iret)
             if (iret.eq.0) goto 101
@@ -258,7 +288,9 @@ c            write (iout,*) "nss",nss
             if (iret.eq.0) goto 101
 #endif
             energy(jj+1)=reini
-            entfac(jj+1)=refree
+cc         write(iout,*) 'reini=', reini, jj+1
+            entfac(jj+1)=dble(refree)
+cc         write(iout,*) 'refree=', refree,jj+1
             rmstb(jj+1)=rmsdev
             do k=1,nres
               do l=1,3
@@ -278,7 +310,11 @@ c            write (iout,*) "nss",nss
           write (iout,*) "Conformation",jjj+1,jj+1
           write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
           write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
-          call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #endif
           call add_new_cconf(jjj,jj,jj_old,icount,Next)
         enddo
@@ -347,14 +383,22 @@ c Check if everyone has the same number of conformations
           write (iout,'(8i10)') i,ntot_all(i)
         enddo
         write (iout,*) "Calculation terminated."
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
         return1
       endif
       return
 #endif
  1111 write(iout,*) "Error opening coordinate file ",
      & intinname(:ilen(intinname))
+#ifdef AIX
+      call flush_(iout)
+#else
       call flush(iout)
+#endif
       return1
       end
 c------------------------------------------------------------------------------
@@ -510,8 +554,12 @@ c Write the structures to a scratch file
 c Master sends the portion of conformations that have been read in to the neighbor
 #ifdef DEBUG
       write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
+#ifdef AIX
+      call flush_(iout)
+#else
       call flush(iout)
 #endif
+#endif
       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
      &    Next,571,MPI_COMM_WORLD,IERROR)
@@ -550,8 +598,12 @@ c------------------------------------------------------------------------------
       icount=1
 #ifdef DEBUG
       write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
+#ifdef AIX
+      call flush_(iout)
+#else
       call flush(iout)
 #endif
+#endif
       do while (icount.gt.0) 
       call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
      &     STATUS,IERROR)
@@ -630,19 +682,34 @@ c
       inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
       write (iout,*) "len=",len," form=",form," acc=",acc
       write (iout,*) "nam=",nam
+#ifdef AIX
+      call flush_(iout)
+#else
       call flush(iout)
 #endif
+#endif
       do ii=istart_conf,iend_conf
         ij = ii - istart_conf + 1
         iii=list_conf(ii)
 #ifdef DEBUG
         write (iout,*) "Reading binary file, record",iii," ii",ii
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #endif
+        if (dyn_ss) then
+        read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+     &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c     &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
+     &    entfac(ii),rmstb(ii)
+        else
         read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
      &    entfac(ii),rmstb(ii)
+        endif
 #ifdef DEBUG
         write (iout,*) ii,iii,ij,entfac(ii)
         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
@@ -651,7 +718,11 @@ c
         write (iout,'(2e15.5)') entfac(ij)
         write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
      &    jhpb_all(i,ij),i=1,nss)
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #endif
       enddo
       return
@@ -687,19 +758,34 @@ c
       inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
       write (iout,*) "len=",len," form=",form," acc=",acc
       write (iout,*) "nam=",nam
+#ifdef AIX
+      call flush_(iout)
+#else
       call flush(iout)
 #endif
+#endif
       do ii=istart_conf,iend_conf
         iii=list_conf(ii)
         ij = ii - istart_conf + 1
 #ifdef DEBUG
         write (iout,*) "Writing binary file, record",iii," ii",ii
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
 #endif
+#endif
+       if (dyn_ss) then
+        write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+     &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c     &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij))
+     &    entfac(ii),rmstb(ii)
+        else
         write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
      &    entfac(ii),rmstb(ii)
+        endif
 #ifdef DEBUG
         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
@@ -707,7 +793,11 @@ c
         write (iout,'(2e15.5)') entfac(ij)
         write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,
      &   nss_all(ij))
-        call flush(iout)
+#ifdef AIX
+      call flush_(iout)
+#else
+      call flush(iout)
+#endif
 #endif
       enddo
       return