C ********************************************************************** C * * C * SOFTWARE LICENSING * C * * C * This program is free software; you can redistribute * C * it and/or modify it under the terms of the GNU * C * General Public License as published by the Free * C * Software Foundation, either Version 2 of the * C * license, or (at your option) any later version. * C * * C * This program is distributed in the hope that it * C * will be useful, but without any warranty; without * C * even the implied warranty of merchantability or * C * fitness for a particular purpose. See the GNU * C * General Public License for more details. * C * * C * A copy of the GNU General Public License is * C * available at http://www.gnu.org/copyleft/gpl.html * C * or by writing to the Free Software Foundation, Inc.,* C * 59 Temple Place - Suite 330, Boston, MA 02111, USA. * C * * C ********************************************************************** SUBROUTINE TRANINP(IFLAG) C C READS HYDRO INPUT FROM hqi_tran FILE AND PREPARES FOR SEDIMENT C TRANSPORT CALCULATIONS C C FOR COUPLING WITH POM AND WET GRID OUTPUT ONLY C C REVISION DATE: JULY 30, 1996 C C********************************************************************** C INCLUDE 'comdeck' C C DECLARE ARRAYS FOR WET GRID OUTPUT C CHARACTER*10 RESTAR COMMON /COAST1/ICNT,INDX(MAXWET),JNDX(MAXWET),RESTAR C DIMENSION WETGU(MAXWET,KBM1), WETGV(MAXWET,KBM1), . WETGW(MAXWET,KB), . WETGAAMX(MAXWET,KBM1), WETGAAMY(MAXWET,KBM1), . WETGKM(MAXWET,KB), WETGKH(MAXWET,KB), . WETGES(MAXWET),WETGED(MAXWET), . WETGS(MAXWET,KBM1),WETGT(MAXWET,KBM1) C C cqa DIMENSION AAMAX(IM,JM,KB),AAMAY(IM,JM,KB) cqa EQUIVALENCE (AAMAX,VH),(AAMAY,VHP) C DIMENSION KHLPF(IM,JM,KB), . SLPF(IM,JM,KB), TLPF(IM,JM,KB), . ULPF(IM,JM,KB), VLPF(IM,JM,KB), WLPF(IM,JM,KB) C REAL*8 ES(IM,JM), ED(IM,JM) C REAL KHLPF C CQA CURRENTLY SEDIMENT TRANSPORT MODEL ONLY USES wet_grid TRANSPORT CQA INPUT STRUCTURE HAS BEEN MODIFIED BASED ON CONVENTIONAL gcm_tran CQA BY QUAMRUL QA 9/2/98 C READ (IUTRN) TMIDDLE cqa write (*,*)'INTX,TIME,TMIDDLE,ICNT=',INTX,TIME,TMIDDLE,ICNT CQA READ (IUTRN) HPRNU C READ (IUTRN) ((WETGU(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGV(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGW(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGAAMX(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGAAMY(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGKH(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGKM(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) (WETGES(I),I=1,ICNT) READ (IUTRN) (WETGED(I),I=1,ICNT) READ (IUTRN) ((WETGS(I,K),I=1,ICNT),K=1,KBM1) READ (IUTRN) ((WETGT(I,K),I=1,ICNT),K=1,KBM1) C DO 330 K=1,KB DO 330 I=1,ICNT WLPF(INDX(I),JNDX(I),K)=WETGW(I,K) KH(INDX(I),JNDX(I),K)=WETGKH(I,K) KM(INDX(I),JNDX(I),K)=WETGKM(I,K) cqa KM(INDX(I),JNDX(I),K)=WETGKH(I,K) 330 CONTINUE C DO 340 K=1,KBM1 DO 340 I=1,ICNT ULPF(INDX(I),JNDX(I),K)=WETGU(I,K) VLPF(INDX(I),JNDX(I),K)=WETGV(I,K) AAMAX(INDX(I),JNDX(I),K)=WETGAAMX(I,K) AAMAY(INDX(I),JNDX(I),K)=WETGAAMY(I,K) T(INDX(I),JNDX(I),K) =WETGT(I,K) S(INDX(I),JNDX(I),K) =WETGS(I,K) 340 CONTINUE c C DO 350 I=1,ICNT ES(INDX(I),JNDX(I))=WETGES(I) ED(INDX(I),JNDX(I))=WETGED(I) 350 CONTINUE C C SET ELEVATION TIME RATE OF CHANGE & INITIAL DEPTH C DO 40 I=1,IM DO 40 J=1,JM C C START OF CALC. FOR IFLAG=0 C IF (IFLAG.EQ.0) THEN ETB(I,J)=ES(I,J) ET(I,J)=ES(I,J) ETF(I,J)=ES(I,J) REWIND (IUTRN) ENDIF C EL(I,J)=ES(I,J) DT(I,J)=H(I,J)+ES(I,J) DETA(I,J)=ED(I,J) 40 CONTINUE C C----------------------------------------------------------------------- C CALCULATE HORIZONTAL MASS FLUXES, (H2*U*D) AND (H1*V*D) C----------------------------------------------------------------------- C DO 10 K=1,KBM1 DO 10 J=2,JMM1 DO 10 I=2,IM XMFL3D(I,J,K)=ULPF(I,J,K)/DZ(K) C C CALC. VELOCITIES C U(I,J,K)=0.0 DBAR=0.25*(DT(I,J)+DT(I-1,J))*(H2(I,J)+H2(I-1,J)) IF (DBAR.GT.0.0) U(I,J,K)=ULPF(I,J,K)/(DZ(K)*DBAR) 10 CONTINUE C DO 20 K=1,KBM1 DO 20 J=2,JM DO 20 I=2,IMM1 YMFL3D(I,J,K)=VLPF(I,J,K)/DZ(K) C C CALC. VELOCITIES C V(I,J,K)=0.0 DBAR=0.25*(DT(I,J)+DT(I,J-1))*(H1(I,J)+H1(I,J-1)) IF (DBAR.GT.0.0) V(I,J,K)=VLPF(I,J,K)/(DZ(K)*DBAR) 20 CONTINUE C C----------------------------------------------------------------------- C C SET VERTICAL VELOCITIES C DO 30 J=1,JM DO 30 K=1,KB DO 30 I=1,IM W(I,J,K)=WLPF(I,J,K)/ART(I,J) 30 CONTINUE C cqa write(*,*)'TMIDDLE,T,S,U,V,=', cqa .TMIDDLE,T(20,20,1),S(20,20,1),U(20,20,1),V(20,20,1) RETURN END