layers_p.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\layers_p.f
00002 !
00049                      SUBROUTINE LAYERS_P
00050 !                    *******************
00051 !
00052      &(PATH_PRE,JG)
00053 !
00054 !***********************************************************************
00055 ! SISYPHE   V6P2                                   21/06/2011
00056 !***********************************************************************
00057 !
00058 !BRIEF   .CSV-FILE OUTPUT OF A LAYER PROFILE IN POINT J
00059 !
00060 !HISTORY  UWE MERKEL
00061 !+        2011-07-20
00062 !+
00063 !+
00064 !
00065 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00066 !| JG             |<--| GLOBAL POINT NUMBER
00067 !| PATH_PRE       |<--| WHERE TO SAVE
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !
00070       USE DECLARATIONS_SISYPHE
00071       USE BIEF
00072       USE BIEF_DEF
00073       !
00074       IMPLICIT NONE
00075 !
00076 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00077 !
00078       INTEGER,          INTENT(IN)    :: JG
00079       CHARACTER(*),        INTENT(IN )    :: PATH_PRE
00080 !
00081 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00082 !
00083       CHARACTER*100, DEBUGFILE
00084       INTEGER  I,K,J
00085       DOUBLE PRECISION DEPTH, AT, MYFRA, BSUM
00086 !
00087 !----------------------------------------------------------------
00088 !
00089       AT = DT*LT/PERCOU
00090 !
00091 !     GLOBAL NUMBERS TO GLOBAL NUMBERS
00092       J = JG
00093 !     NOTE JMH : KNOGL WILL BE SUPPRESSED IN FUTURE
00094       IF(NCSIZE>1) J = GLOBAL_TO_LOCAL_POINT(JG,MESH)
00095 !
00096       WRITE(UNIT=DEBUGFILE, FMT='(A,I8,A,G15.8,A)')
00097      &      PATH_PRE,JG,'_T_',AT,'.LAY.CSV'
00098       DO I=1,38
00099         IF(DEBUGFILE(I:I)==' ') DEBUGFILE(I:I)='_'
00100       END DO
00101 !
00102       IF(J > 0) THEN !0 IF NODE IS NOT ON THIS PARTITION
00103       OPEN(80, FILE=DEBUGFILE , STATUS='UNKNOWN')
00104         REWIND 80
00105         WRITE(80,*)"J K FD50(I) AT Z AVAIL(J,K,I) X Y D50 TAU H"
00106 !
00107         DEPTH = ZF%R(J)
00108 !
00109         !LAYER TOP
00110         DO K=1,NLAYER%I(J)
00111 !
00112           BSUM = 0.D0
00113           DO I=1,NSICLA
00114             BSUM = FDM(I)*AVAIL(J,K,I) + BSUM
00115           ENDDO
00116 !
00117           DO I=1,NSICLA
00118             WRITE (80,'(I8,1X,I4,1X,7(G15.8,1X))')
00119      &      JG,(NLAYER%I(J)-K+1),FDM(I),AT,DEPTH,
00120      &      AVAIL(J,K,I),X(J),Y(J), BSUM, TOB%R(J), Z%R(J)
00121           ENDDO
00122             DEPTH = DEPTH - ES(J,K)
00123 
00124         ENDDO
00125 !
00126 !     RIGID BED
00127 !
00128       DO I=1,NSICLA
00129         BSUM = FDM(I)*AVAIL(J,NLAYER%I(J),I) + BSUM
00130       ENDDO
00131 !
00132       DO I=1,NSICLA
00133             MYFRA = 0.D0
00134             IF (I==1) MYFRA = 1.D0
00135             WRITE (80,'(I8,1X,I4,1X,7(G15.8,1X))')
00136      &      JG,0,FDM(I),AT,DEPTH,MYFRA,X(J),Y(J),BSUM
00137       ENDDO
00138 !
00139       CLOSE(80)
00140       ENDIF
00141 !
00142 !----------------------------------------------------------------
00143 !
00144       RETURN
00145       END SUBROUTINE LAYERS_P

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0