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 ********************************************************************** PROGRAM POM_rain C C********************************************************* C ECOMSED MODEL C VERSION 1.1 C OCTOBER 1996 C********************************************************* C INCLUDE 'comdeck' C C----------------------------------------------------------------------| C GENERAL CIRCULATION MODEL | C ORTHOGONAL CURVILINEAR COORDINATE VERSION | C ECOM3D | C | C | C THIS IS A VERSION OF THE THREE DIMENSIONAL, TIME DEPENDENT, | C PRIMITIVE EQUATION, CIRCULATION MODEL DEVELOPED BY GEORGE MELLOR | C AND ALAN BLUMBERG WITH SUBSEQUENT CONTRIBUTIONS BY LEO OEY AND | C BORIS GALPERIN. | C | C | C FOR DETAILS OF THE GOVERNING EQUATIONS AND SOLUTION | C TECHNIQUES THE INTERESTED READER IS REFERRED TO: | C | C BLUMBERG, A.F. AND G.L. MELLOR, "DIAGNOSTIC AND PROGNOSTIC | C NUMERICAL CIRCULATION STUDIES IN THE SOUTH ATLANTIC BIGHT," | C J. GEOPHYS. RES., 88, 4579-4592, 1983. | C | C AND | C | C BLUMBERG, A.F. AND G.L. MELLOR, "A DESCRIPTION OF A THREE- | C DIMENSIONAL COASTAL OCEAN CIRCULATION MODEL," IN: THREE | C DIMENSIONAL SHELF MODELS, COASTAL AND ESTUARINE SCIENCES, | C 5, N. HEAPS, ED., AMERICAN GEOPHYSICAL UNION, 1987. | C | C | C IN SUBROUTINE PROFQ THE MODEL MAKES USE OF THE TURBULENCE | C CLOSURE SUB-MODEL DESCRIBED IN: | C | C MELLOR, G.L. AND T. YAMADA, "DEVELOMENT OF A TURBULENCE | C CLOSURE MODEL FOR GEOPHYSICAL FLUID PROBLEMS," REV. GEOPHYS. | C SPACE PHYS., 20, 851-875, 1982. | C | C AND | C | C GALPERIN, B., L.H. KANTHA, S. HASSID AND A. ROSATI, "A QUASI- | C EQUILIBRIUM TURBULENT ENERGY MODEL FOR GEOPHYSICAL FLOWS," | C J. ATMOS. SCI. 45, 55-62, 1988. | C | C THIS PROGRAM CONTAINS A NUMBER OF COMMENT CARDS THAT | C SHOULD ENABLE AN ASTUTE OCEAN SCIENTIST TO MAKE SIMULATIONS. | C PLEASE DIRECT CRITICISMS AND SUGGESTIONS TO ME. | C | C ALAN BLUMBERG | C HYDROQUAL, INC | C MAHWAH, NJ | C 12/28/89 | C | C----------------------------------------------------------------------| C | C LOOP LIMITS | C | C T,S,etc : J=2,JMM1 | C I=2,IMM1 | C | C U : J=2,JMM1 | C I=3,IMM1 | C | C V : J=3,JMM1 | C I=2,IMM1 | C | C----------------------------------------------------------------------| C DIMENSION ADVUA(IM,JM),ADVVA(IM,JM),ADVUU(IM,JM),ADVVV(IM,JM) DIMENSION DRHOX(IM,JM,KB),DRHOY(IM,JM,KB),TRNU(IM,JM),TRNV(IM,JM) DIMENSION COM(80) DIMENSION IVAR(IM),PRT(IM,KB) C REAL DUMB1(QBCM),DUMB2(EBCM,KBM1),DUMB3(DBCM) DIMENSION DUMP1(IM,JM),DUMP2(IM,JM,KB) chli INTEGER TMP_IYR,TMP_IMO,TMP_IDA,TMP_IHOUR chli C C LIMIT DEPOSITION TO BATHYMETRIC DEPTH C PRAVI 08/12/99 C REAL COHTHK(IM,JM),NCOHTHK(IM,JM) C EQUIVALENCE (IVAR,TPS),(PRT,A) C CHARACTER*10 RESTAR,OPTION CHARACTER*10 OPTBFRIC,OPTHORCON,OPTUMOL,TROPT CHARACTER*10 OPTZ0B !RMarsooli_May2015 CHARACTER*4 IPLTFORM,OPTAVG,ITRNFORM CHARACTER OFORM*3,TRICOPT*5 cqa use common block when HOT START and EXTERNAL COMMON /COAST1/ICNT,INDX(MAXWET),JNDX(MAXWET),RESTAR * ****** NEW VARIABLES OF antidif.f BC Khan 080999 DIMENSION TBDRY2(EBCM,KBM1), SBDRY2(EBCM,KBM1) ****** NEW VARIABLES OF antidif.f BC Khan 080999 DIMENSION HRSRESTART(99) ! NG 2009, as ammended for multiple restarts in 2011 CHARACTER*10 STARTFL * CNG Data UTCSHIFT /0.0/ ! DANGER:... ONLY IF START DATE in run_data ! IS IN LST (E.G. if New York LST, UTCSHIFT=-5.0) CNG Data WDSMAX /50.0/ ! Max wind used for wind stress calculations Data WDSMAX /100./ ! Max wind used for wind stress calculations Data PATMOPT /1./ ! Set PATMOPT to 1 only if barometric load adjustment ! of surface elevation is to be included SMALLVAL=0.00000000000010 !RMarsooli C IURUN=1 ! run_data IUGRD=3 ! model_grid (opened & closed in setdom.f) IUTAS=5 ! init_tands (opened & closed in tands.f) IUUAV=7 ! synop_wind (opened & closed in bcdata.f) IURRT=8 ! hrsrestart (opened & closed in ecom3d.f, optional) ! CNG06152009 IURRS=9 ! restart (opened & closed in ecom3d.f) C IUPRT=10 ! gcmprt IUPLT=12 ! gcmplt IUTSR=14 ! gcmtsr IUWRS=16 ! startup (opened & closed in ecom3d.f) IUTRN=18 ! gcm_geom (opened & closed in transport.f) C ! gcm_tran (opened & closed in transport.f) C IUT65=65 ! elevation potential cells NG04232008 IUT90=90 ! elevation boundary conditions IUT91=91 ! river discharges IUT92=92 ! diffuser intake/outfall IUT93=93 ! meteorological data IUT94=94 ! temperature & salinity boundary conditions IUT95=95 ! synoptic wind stress comp (opened in bcdata.f) IUT96=96 ! diffuser intake/outfall in loop IUT103=103 ! synoptic wind and heat flux input file IUT104=104 ! synoptic precipitation and evaporation flux input file (synop_pet, optional) NG 2014 IUT191=191 ! synoptic heat flux input file IUT192=192 ! synoptic heat flux (temp file) CNG04092008 Not anymore IUT193=193 ! synoptic wind velocity components CNG04092008c (opened in bcdata.f) used by wave model IUT194=194 ! 2d varying extinction coefficients IUT801=801 ! 2d extinction coefficients (user input) c IUT195=195 ! wave parameters at open b.c. IUT802=802 ! wave parameters at open b.c. (wave.inp, optional) NG 2007+ c IUT196=196 ! ICE PARAMETERS NG 2011+ C C******************************************************************** C C THESE FILES ARE OPENED IN bcdata.f C C DISSOLVED TRACER TRANSPORT C IUT501=501 ! tracer conc. at open b.c. IUT601=601 ! tracer conc. at river discharges IUT98=98 ! tracer conc. at diffuser intake/outfall IUT99=99 ! tracer conc. at diffuser intake/outfall loop IUT701=701 ! tracer load at point source C C SEDIMENT TRANSPORT C IUT502=502 ! coh sed conc. at open b.c. IUT503=503 ! non-coh sed conc. at open b.c. IUT602=602 ! coh sed conc. at river discharges IUT603=603 ! non-coh sed conc.river discharges IUT702=702 ! coh sed conc. at Diffuser discharges IUT703=703 ! non-coh sed conc Diffuser discharges C C PARTICLE-BOUND TRACER TRANSPORT C IUT504=504 ! coh sed conc. at open b.c. IUT505=505 ! non-coh sed conc. at open b.c. IUT604=604 ! coh sed conc. at river discharges IUT605=605 ! non-coh sed conc.river discharges IUT704=704 ! coh sed conc. at Diffuser discharges IUT705=705 ! non-coh sed conc Diffuser discharges C C******************************************************************* OPEN (IURUN,FILE='run_data') OPEN (IUPRT,FILE='gcmprt') OPEN (IUT90,FILE='gcm_temp90') OPEN (IUT91,FILE='gcm_temp91') OPEN (IUT92,FILE='gcm_temp92') OPEN (IUT93,FILE='gcm_temp93') c OPEN (IUT193,FILE='gcm_temp193') OPEN (IUT94,FILE='gcm_temp94') OPEN (IUT96,FILE='gcm_temp96') C READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) READ(IURUN,11) (COM(I),I=1,80) 11 FORMAT(80A1) 12 FORMAT(/1X,80A1/) C C C******************************************************************** C C HYDTYPE = 'INTERNAL' : USE ECOM HYDRODYNAMICS C = 'EXTERNAL' : USE POM HYDRODYNAMICS INPUT FROM hqi_tran C C NHYD = NO. OR TIMESTEPS BETWEEN EACH hqi_tran INPUT (ASSUMED CONSTANT) C C WAVEDYN = 'NEGLECT ' ==> NO EFFECT OF WAVES ON BOTTOM FRICTION C = 'SMBMODEL' ==> WAVES EFFECT BOT FRIC COEFF - SMB THEORY C = 'DONMODEL' ==> WAVES EFFECT BOT FRIC COEFF - Donelan(1977) THEORY C = 'DONONLY ' ==> WAVES ONLY CALCULATION - Donelan(1977) THEORY C = 'EXTERNAL' ==> WAVES EFFECT BOT FRIC COEFF - INPUT WAM RESULTS C C TRACER = 'NEGLECT' : NO CONSERVATIVE TRACER CALC. C = 'INCLUDE' : CONSERVATIVE TRACER C C SEDTRAN = 'NEGLECT' : NO SEDIMENT TRANSPORT C = 'INCLUDE' : SEDIMENT TRANSPORT C C CHEMTRAN = 'NEGLECT' : NO CHEMICAL TRANSPORT (PARTICLE BOUND) C = 'INCLUDE' : CHEMICAL TRANSPORT (PARTICLE BOUND) C (ONLY USE IF SEDTRAN = 'INCLUDE') C C PARTICLE = 'NEGLECT' : NO PARTICLE TRACKING C = 'INCLUDE' : PARTICLE TRACKING C C SEDTYPE = 'BOTH' : COHESIVE & NON-COHESIVE C = 'SAND' : NON-COHESIVE ONLY C = 'MUD' : CODESIVE ONLY C C NOTE: SEDTYPE APPLIES TO SEDIMENT TRANSPORT AND PARTICLE-BOUND C CHEMICAL (TRACER) TRANSPORT C READ(IURUN,1) HYDTYPE,WAVEDYN,TRACER,SEDTRAN,CHEMTRAN,SEDTYPE, + PARTICLE,WETLAND 1 FORMAT(2X,A8,2X,A8,3X,A7,3X,A7,3X,A7,6X,A4,3X,A7,1X,A7) C IF (WAVEDYN.NE.'SMBMODEL'.AND.WAVEDYN.NE.'DONMODEL'.AND. . WAVEDYN.NE.'EXTERNAL'.AND.WAVEDYN.NE.'NEGLECT '.AND. . WAVEDYN.NE.'MELLOR'.AND. !RMarsooli, August2015 . WAVEDYN.NE.'DONONLY ')THEN WRITE(IUPRT,6112)WAVEDYN CALL SYSTEM ('rm gcm_temp*') STOP ENDIF cqa C C OPEN AUXILIARY INPUT FILES C C FILE UNIT DESCRIPTION C water_trace.inp IUT401 DISSOLVED TRACER C coh_sed.inp IUT402 SEDIMENT TRANSPORT, COHESIVE C noncoh_sed.inp IUT403 SEDIMENT TRANSPORT, NON-COHESIVE C coh_trace.inp IUT404 PARTICLE-BOUND TRACER, COHESIVE C noncoh_trace.inp IUT405 PARTICLE-BOUND TRACER, NON-COHESIVE C partrack.inp IUT406 PARTICLE TRACKING C IF (TRACER.EQ.'INCLUDE') THEN IUT401=401 OPEN (UNIT=IUT401,FILE='water_trace.inp',FORM='FORMATTED') ENDIF C IF (SEDTRAN.EQ.'INCLUDE') THEN IF (SEDTYPE.EQ.'MUD ') THEN IUT402=402 OPEN (UNIT=IUT402,FILE='coh_sed.inp',FORM='FORMATTED') C KSED=1 ENDIF C IF (SEDTYPE.EQ.'SAND') THEN IUT403=403 OPEN (UNIT=IUT403,FILE='noncoh_sed.inp',FORM='FORMATTED') C KSED=1 ENDIF C IF (SEDTYPE.EQ.'BOTH') THEN IUT402=402 IUT403=403 OPEN (UNIT=IUT402,FILE='coh_sed.inp',FORM='FORMATTED') OPEN (UNIT=IUT403,FILE='noncoh_sed.inp',FORM='FORMATTED') C KSED=2 ENDIF ENDIF C IF (CHEMTRAN.EQ.'INCLUDE') THEN IF (SEDTYPE.EQ.'MUD ') THEN IUT404=404 OPEN (UNIT=IUT404,FILE='coh_trace.inp',FORM='FORMATTED') ENDIF C IF (SEDTYPE.EQ.'SAND') THEN IUT405=405 OPEN (UNIT=IUT405,FILE='noncoh_trace.inp',FORM='FORMATTED') ENDIF C IF (SEDTYPE.EQ.'BOTH') THEN IUT404=404 IUT405=405 OPEN (UNIT=IUT404,FILE='coh_trace.inp',FORM='FORMATTED') OPEN (UNIT=IUT405,FILE='noncoh_trace.inp',FORM='FORMATTED') ENDIF ENDIF C IF (PARTICLE.EQ.'INCLUDE') THEN IUT406=406 OPEN (UNIT=IUT406,FILE='partrack.inp',FORM='FORMATTED') ENdIF IF (WETLAND.EQ.'INCLUDE') THEN !RMarsooli_Jan2015 IUVEG=19 OPEN (UNIT=IUVEG,FILE='wetland_data',FORM='FORMATTED') ENdIF C C******************************************************************** C C READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,2) DTI,ISPLIT,IRAMP,IYR,IMO,IDA,IHR,NHYD,SGW,WETEPS, & WETMIN !IRAMP=86400*5 IHOUR=IHR 2 FORMAT(1F10.4,7I5,F5.0,2F10.0) C c keep year being 4-digit number (hli, 04/07/2000) c IF(IYR.GE.100)THEN c ICE=IYR/100 c IYR=IYR-ICE*100 ! i.e. 1996 --> 96 c ELSE c ICE=19 ! century c END IF c end CALL CDAY(IDA,IMO,IYR,IJDAY,1) SDAY=float(IJDAY)+FLOAT(IHOUR)/24. CALL CDAY(1,1,IYR,J1JDAY,1) J1YR = IYR CALL CDAY(1,1,J1YR+1,J2JDAY,1) ! QA cend, modified for heatflux calculation by jeff ji, 8/30/94 C C DTE=DTI/FLOAT(ISPLIT) DTE2=2.*DTE DTI2=2.*DTI ISPI=1./FLOAT(ISPLIT) ISP2I=.5*ISPI DAYI=1./86400. GRAV=9.806 pi = 3.141593 !RMarsooli CNG INITIALIZE HRSRESTART! If greater than 0, hrs after start that startup is generated NRESEND=0 NENDLESS=1 OPEN (IURRT,FILE='hrsrestart.txt',STATUS='old',ERR=19) DO NENDLESS=1,99 READ (IURRT,*,END=19,ERR=19) HRSINNG IF (HRSINNG.GT.0.) THEN NRESEND=NRESEND+1 HRSRESTART(NRESEND)=HRSINNG IF . (NRESEND.GT.1.AND.HRSRESTART(NRESEND).LE.HRSRESTART(NRESEND-1)) . THEN WRITE (*,*) 'hrsrestart.txt entries not in ascending order!' WRITE (*,*) 'Please rearrange them and resubmit.' STOP ENDIF ENDIF ENDDO CLOSE (IURRT) 19 NRESTART=1 IF (NRESEND.GT.0) THEN DO NENDLESS=1,NRESEND WRITE(*,*) + 'startup file will be generated ',HRSRESTART(NENDLESS), + ' hrs after start.' ENDDO ELSE WRITE(*,*) + 'startup file will be generated at the end of run.' ENDIF C WRITE(IUPRT,21) DTI,DTE,ISPLIT,IRAMP,IYR,IMO,IDA,IHOUR ! JI 21 FORMAT( . ' BAROCLINIC TIME STEP IS ',F10.4,' SECONDS',//, . ' BAROTROPIC TIME STEP IS ',F10.4,' SECONDS',//, . ' INTERNAL/EXTERNAL MODE SPLITTING IS ',I10//, . ' NUMBER OF RAMP TIME STEPS ',I10//, & ' THE STARTING TIME IS ', 4i5//) ! JI 211 FORMAT( & ' HOT STARTING TIME IS AROUND ', 4i5//) C WRITE (IUPRT,5002)TRACER,SEDTRAN,CHEMTRAN,SEDTYPE,PARTICLE,HYDTYPE + ,WAVEDYN,WETLAND,SGW,WETEPS,WETMIN 5002 FORMAT (//5X,'MODEL OPTIONS: TRACER =',3X,A7,/20X,'SEDTRAN =', + 3X,A7,/20X,'CHEMTRAN =',3X,A7/20X,'SEDTYPE =',6X,A4, + /20X,'PARTICLE =',3X,A7,/20X,'HYDTYPE =',2X,A8, + /20X,'WAVEDYN =',2X,A8, . /20X,'WETLAND =',2X,A8, !WETLAND-RMarsooli_Jan2015 & /20X,'SGW =',2X,F8.2, !WAD (hli,08/10/05) & /20X,'WETEPS =',2X,F8.2, !WAD & /20X,'WETMIN =',2X,F8.2//) !WAD C C C C----------------------------------------------------------------------- C TYPE OF RUN - C BAROTROPIC: 2-D CALCULATION (BOTTOM STRESS CALCULATED IN ADVAVE) C PROGNOSTIC: 3-D CALCULATION (BOTTOM STRESS CALCULATED IN PROFU,V) C By Quamrul 7/12/99 QA C TEMP_ONLY : 3-D CALCULATION (BOTTOM STRESS CALCULATED IN PROFU,V) C : ONLY TEMPERATURE IS CALCULATED C SALT_ONLY : 3-D CALCULATION (BOTTOM STRESS CALCULATED IN PROFU,V) C : ONLY SALINITY IS CALCULATED C DIAGNOSTIC: 3-D CALCULATION WITH T AND S HELD FIXED C----------------------------------------------------------------------- C 3-D - TYPE OF MOMENTUM ADVECTION AND BOTTOM FRICTION C LINEAR : ALL MOMENTUM ADVECTION NEGLECTED C NON-LINEAR: COMPLETE PHYSICS C---------------------------------------------------------------------- C 3-D - TYPE OF ADVECTION INTEGRATION SCHEME C CENTRAL : CENTRAL FINITE DIFFERENCE SCHEME C UPWIND : UPWIND FINITE DIFFERENCE SCHEME C SMOLAR_R : FINITE DIFFERENCE SCHEME DUE TO SMOLARKIEWICZ USING C RECURSIVE FORMULATION FOR THE ANTIDIFFUSIVE VELOCITIES C (MOMENTUM AND TURBULENCE ARE UPWIND) C ( to be implemented, now central) C SMOLAR_2 : FINITE DIFFERENCE SCHEME DUE TO SMOLARKIEWICZ USING C TWO PASSES FOR CORRECTIONS OF THE NUMERICAL DIFFUSION C (MOMENTUM AND TURBULENCE ARE UPWIND) C ( to be implemented, now central) C---------------------------------------------------------------------- C READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,10) NSTEPS,IPRINT,IPRTSTART,RESTAR,TOR,ADVECT,SCHEME READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,4) DEV,VSX,JROW,VSY,IROW, . PTU,PTV,PTW,PTAM,PTS,PTT,PRHO,PTQ2,PTL,PTKM,PTKH READ(IURUN,11) (COM(I),I=1,80) TNDAYS=FLOAT(NSTEPS)*DAYI*DTI EDAY=SDAY+TNDAYS C PUT WARNING IF TOR IS PROGNOSTIC AND SGW COEFFICIENT IS SET 0.0 IF(SGW.EQ.0.0.AND.TOR.EQ.'PROGNOSTIC ')THEN WRITE(IUPRT,*)'YOU HAVE SPECIFIED SGW = 0.0 AND TOR=PROGNOSTIC' WRITE(IUPRT,*)'IF SGW = 0.0, TOR SHOULD BE DIAGNOSTIC' WRITE(IUPRT,*)'PLEASE REFER TO USERS MANUAL FOR MORE DETAILS OF . SGW COEFFICIENT' WRITE(IUPRT,*)'PLEASE CORRECT THIS AND RESUBMIT RUN' STOP END IF C C WAVEHYD = 'NEGLECT' ==> NO EFFECT OF WAVES ON BOTTOM FRICTION C = 'INLCUDE' ==> WAVES EFFECT BOTTOM FRICTION COEFF. C C NWAVE = NUMBER OF TIMESTEPS BETWEEN UPDATING NEW BOTTOM FRICTION COEFF. C C READ(IURUN,3) BFRIC,Z0B,NU,ALPHA,TLAG,NWAVE C Modified by Quamrul QA 12/28/98 C C Introduce ALPHA as Advection Time Scale for T and S C and TLAG for Friction Time Scale for Barotropic Radiation C Boundary Conditions (PCLAMP) DO J=1,JM DO I=1,IM VARBF(I,J)=1.0 VARHF(I,J)=1.0 VARUF(I,J)=1.0 END DO END DO READ(IURUN,3) OPTBFRIC,OPTZ0B,NU,THETA,ALPHA,TLAG,NWAVE,BCTYPE !RMarsoolI_Jan2015 cc READ(IURUN,11) (COM(I),I=1,80) cc READ(IURUN,'(E10.3,1x,A3)') CDWALL !VARIABLE BED ROUGHNESS HEIGHT Z0B IF(OPTZ0B(7:10).EQ.'VARI'.AND.TOR.NE.'BAROTROPIC')THEN OPEN (71,FILE='fricz0b.inp',STATUS='OLD') READ(71,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) READ(71,*)NVARZ0B,Z0BTEMP WRITE(IUPRT,'(I5,E10.4)')NVARZ0B,Z0BTEMP C Z0B=Z0BTEMP READ(71,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) DO N=1,NVARZ0B READ(71,*)II,JJ,Z0B(II,JJ) WRITE(IUPRT,'(2I5,E10.3)')II,JJ,Z0B(II,JJ) END DO OPTZ0B='VARIABLE' CLOSE(71) ELSE READ(OPTZ0B,'(F10.6)')Z0BTEMP C Z0B=Z0BTEMP OPTZ0B='UNIFORM' ENDIF CNG11302010 IF(WAVEDYN.NE.'NEGLECT '.AND.NWAVE.NE.1) ! NG04272010 CNG11302010 . PAUSE 'NWAVE<>1 NOT YET SUPPORTED FOR WAVE SIMULATIONS.'// CNG11302010 . 'PLEASE SET TO 1 IN RUN_DATA.' IF(OPTBFRIC(7:10).EQ.'VARI')THEN OPEN (70,FILE='bfric2d.inp',STATUS='OLD') READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) READ(70,'(I5,E10.4)')NVARBF,BFRIC WRITE(IUPRT,'(I5,E10.4)')NVARBF,BFRIC IF(NVARBF.GT.MAXWET)THEN WRITE(IUPRT,56)NVARBF,MAXWET CALL SYSTEM ('rm gcm_temp*') STOP ENDIF READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) DO N=1,NVARBF READ(70,55)II,JJ,VARBF(II,JJ) WRITE(IUPRT,55)II,JJ,VARBF(II,JJ) END DO CLOSE(70) OPTBFRIC='VARIABLE' ELSEIF(OPTBFRIC.EQ.'MANNINGS-N')THEN IF(TOR.NE.'BAROTROPIC') PAUSE 'Mannings-N needs BAROTROPIC!' OPEN (70,FILE='bfric2d.inp',STATUS='OLD') READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) READ(70,'(I5,E10.4)')NVARBF,BFRIC ! Bfric is minimum here NVARBF=MAXWET ! and NVARBF is redefined as the whole IxJ space WRITE(IUPRT,'(A,I8,A,E10.4)')'REDEFINED NVARBF:',NVARBF, + ' WITH MINIMUM BFRIC:',BFRIC READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) DO N=1,NVARBF READ(70,55)II,JJ,VARMN(II,JJ) ! VARMN is the actual Manning's number here, not a scaling factor WRITE(IUPRT,55)II,JJ,VARMN(II,JJ) END DO CLOSE(70) ELSE READ(OPTBFRIC,'(F10.3)')BFRIC OPTBFRIC='UNIFORM' ENDIF C IF(BCTYPE.EQ.' ')BCTYPE='CLAMPED' IF(BCTYPE.NE.'IRANDB '.AND.BCTYPE.NE.'OCLAMP '.AND. 1BCTYPE.NE.'CLAMPED'.AND.BCTYPE.NE.'PCLAMP '.AND. 2BCTYPE.NE.'RANDB '.AND.BCTYPE.NE.'MIXED ') THEN WRITE(IUPRT,6110) BCTYPE GOTO 9100 END IF IF(BCTYPE.EQ.'PCLAMP '.AND.TLAG.EQ.0.0) THEN WRITE(IUPRT,6111) BCTYPE,TLAG GOTO 9100 ENDIF C NWAVECNT=0 C READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,23) HORZMIX,OPTHORCON,HPRNU !BACKGROUND HORIZONTAL VISCOSITY-RMarsooli_Jan2015 READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,'(E10.3)') HORBACK IF(OPTHORCON(7:10).EQ.'VARI')THEN OPEN (70,FILE='horcon2d.inp',STATUS='OLD') READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) READ(70,'(I5,E10.3)')NVARHF,HORCON WRITE(IUPRT,5)NVARHF IF(NVARHF.GT.MAXWET)THEN WRITE(IUPRT,57)NVARHF,MAXWET CALL SYSTEM ('rm gcm_temp*') STOP ENDIF READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) DO N=1,NVARHF READ(70,55)II,JJ,VARHF(II,JJ) WRITE(IUPRT,55)II,JJ,VARHF(II,JJ) END DO CLOSE(70) ELSE READ(OPTHORCON,'(E10.4)')HORCON ENDIF READ(IURUN,11) (COM(I),I=1,80) READ(IURUN,23) VERTMIX,OPTUMOL,VPRNU IF(OPTUMOL(7:10).EQ.'VARI')THEN OPEN (70,FILE='umol2d.inp',STATUS='OLD') READ(70,11) (COM(I),I=1,80) READ(70,'(I5,E10.4)')NVARUF,UMOL WRITE(IUPRT,'(I5,E10.4)')NVARUF,UMOL IF(NVARUF.GT.MAXWET)THEN WRITE(IUPRT,58)NVARUF,MAXWET CALL SYSTEM ('rm gcm_temp*') STOP ENDIF READ(70,11) (COM(I),I=1,80) WRITE(IUPRT,11) (COM(I),I=1,80) DO N=1,NVARUF READ(70,55)II,JJ,VARUF(II,JJ) WRITE(IUPRT,55)II,JJ,VARUF(II,JJ) END DO CLOSE(70) ELSE READ(OPTUMOL,'(E10.4)')UMOL ENDIF 55 FORMAT(2I5,E10.3) 56 FORMAT(/' NUMBER OF GRID OF VARIABLE BFRIC ',I5,' IS GREATER THAN * MAXIMUM ALLOWED.',I5// ' PLEASE FIX THIS AND RESUBMIT'//) 57 FORMAT(/' NUMBER OF GRID OF VARIABLE HORCON ',I5,' IS GREATER THAN * MAXIMUM ALLOWED.',I5// ' PLEASE FIX THIS AND RESUBMIT'//) 58 FORMAT(/' NUMBER OF GRID OF VARIABLE UMOL ',I5,' IS GREATER THAN * MAXIMUM ALLOWED.',I5// ' PLEASE FIX THIS AND RESUBMIT'//) 4 FORMAT(2X,A3,2(4X,A1,I5),11(4X,A1)) CRM 3 FORMAT(A10,5E10.3,I10,3X,A7) 3 FORMAT(2A10,4E10.3,I10,3X,A7) !RMarsooli_May2015 10 FORMAT(3I10,1X,A10,1X,A10,1X,A10,1X,A10) 23 FORMAT(2A10,2E10.3) C C***************************************************************** C C CONSERVATIVE TRACER INPUT SECTION C CONDRAT = TRACER DECAY RATE (1/day) C CONINIT = INITIAL TRACER CONCENTRATION (ASSUMED SPATIALLY CONSTANT) C IF (TRACER.EQ.'INCLUDE') THEN Cqa Add decay rates 11/16/01 READ (IUT401,11) (COM(I),I = 1,80) READ (IUT401,5009)TROPT,TRICOPT,CONDRAT,CONINIT,THETAT,VSRATE, . ASOL,ASAL 5009 FORMAT (A10,5X,A5,6F10.0) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5119)TROPT,TRICOPT,CONDRAT,CONINIT,THETAT,VSRATE, . ASOL,ASAL 5119 FORMAT ('Tracer Option=',A10,/ . 'Initial Data Option=',A5,1X,/ . 'Background/Freshwater Decay Rate=',F15.5/ . 'Initial Concentration of Tracer=',F15.5/ . 'Temperature Coefficient Theta=',F15.5/ . 'Settling rate of Particulate Bacteria=',F15.5/ . 'Proportionallity Constant for Insolation =',F15.5/ . 'Switch for Salinity Dependance =',F15.5) C C CONVERT DECAY RATE FROM 1/day TO 1/s C Cqa CONDRAT=CONDRAT/86400. Cqa We use decay rate function of T,S, and Io Cqa The CONDRAT is now decay rate at T=20 deg C and in Freshwater Cqa So we will change unit of CONSRAT in advcon.f Cqa CONDRAT is = 0.8 (Mancini, 1978) by Quamrul QA 11/12/01 C CHECK THE VALIDITY OF INPUT FILE IF(TROPT.NE.'PATHOGEN '.AND.TROPT.NE.'SIMPDECAY '.AND. . TROPT.NE.'CONSERV ')THEN WRITE(IUPRT,5120)TROPT STOP 5120 FORMAT('TRACER OPTION', 5X,A10,5X,' IS NOT A VALID OPTION'/ . 'PLEASE CORRECT THIS AND RESUBMIT THE RUN') END IF IF(TROPT.EQ.'PATHOGEN '.AND.THETAT.EQ.0.0)THEN WRITE(IUPRT,*)'FOR PATHOGEN SIMULATIONS THETAT CANNOT BE ZERO' WRITE(IUPRT,*)'FIX THIS INPUT AND RESUBMIT' STOP END IF ENDIF C C********************************************************************** C C SEDIMENT TRANSPORT INPUT SECTION C IF (SEDTRAN.EQ.'INCLUDE') THEN C C COHESIVE SEDIMENT INPUT C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5010)NSEDBEG,NSBED 5010 FORMAT (3I10) C XNSBED=FLOAT(NSBED) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5010)NSEDBEG,NSBED C C WS1 = ADEP * (C*G) ** DEPEXP C C ADEP = CONSTANT, CLASS 1 SETTLING SPEED IN um/s C C PDEPFORM = 'KRONE' C = 'PARTH' C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5019)ADEP,DEPEXP,TCRDEP,PDEPFORM 5020 FORMAT (8F10.0) 5019 FORMAT (3F10.0,5X,A5) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5019)ADEP,DEPEXP,TCRDEP,PDEPFORM C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5018)A0IN,RESEXP,EXPM,VARIA0N 5018 FORMAT (3F10.0,3X,A7) C C IA0=0 IF (VARIA0N.EQ.'INCLUDE') IA0=1 C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020)A0IN,RESEXP,EXPM C READ (IUT402,11) (COM(I),I = 1,80) C C MODIFIED BY C.K.Z. ON 4/21/97 C C ADDED Z0 FOR WAVES C READ (IUT402,5017)DENCOH,VARIBULK,P0(1),VARIP0,BFCOH,Z0BCOH, + Z0WAVE 5017 FORMAT (F10.0,3X,A7,F10.0,3X,A7,3F10.0) C IP0=0 IF (VARIP0.EQ.'INCLUDE') IP0=1 C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5017)DENCOH,VARIBULK,P0(1),VARIP0,BFCOH,Z0BCOH, + Z0WAVE C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5020) (FTIME(LL),LL=1,LAYMAX) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020) (FTIME(LL),LL=1,LAYMAX) C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5020) (TSED0IN(LL),LL=1,LAYMAX) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020) (TSED0IN(LL),LL=1,LAYMAX) C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5020) (TAUCR(LL),LL=1,LAYMAX) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020) (TAUCR(LL),LL=1,LAYMAX) C C INPUT INITIAL SUSPENDED SEDIMENT CONCENTRATIONS C C ASSUMED TO BE SPATIALLY CONSTANT C READ (IUT402,11) (COM(I),I = 1,80) READ (IUT402,5020) CSI(1) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020) CSI(1) ENDIF C C NON-COHESIVE SEDIMENT INPUT C IF (SEDTYPE.EQ.'SAND'.OR.SEDTYPE.EQ.'BOTH') THEN C READ (IUT403,11) (COM(I),I = 1,80) READ (IUT403,5010)NSEDBEG,NSBED C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5010)NSEDBEG,NSBED C READ (IUT403,11) (COM(I),I = 1,80) READ (IUT403,5021)WS2,DENNON,VARIBULK,SUSARM,BEDTHI 5021 FORMAT (2F10.0,3X,A7,2F10.0) C C CONVERT INPUT NON-COHESIVE BED THICKNESS FROM cm TO m C BEDTHI=BEDTHI/100. C XNSBED=FLOAT(NSBED) C C C INPUT INITIAL SUSPENDED SEDIMENT CONCENTRATIONS C C ASSUMED TO BE SPATIALLY CONSTANT C READ (IUT403,11) (COM(I),I = 1,80) READ (IUT403,5020) CSI(2) C WRITE (IUPRT,11) (COM(I),I = 1,80) WRITE (IUPRT,5020) CSI(2) C IF (SEDTYPE.EQ.'SAND') CSI(1)=CSI(2) ENDIF C C C CONVERT INITIAL CONCENTRATIONS FROM mg/l TO g/cm**3 C DO 5022 K=1,KSED CSI(K)=CSI(K)/1000000. 5022 CONTINUE C C INITIALIZE COUNTERS C NSEDCT=0 !Check for 0 ini. Pravi in STCODE NBLOW=0 !Check for 0 ini. N24CNT=0 !Check for 0 ini. C NHR=NINT(3600./DTI) N24HR=24*NHR ENDIF C C********************************************************************** C C CHEM TRANSPORT INPUT C IF (CHEMTRAN.EQ.'INCLUDE') THEN C C CHEMI(1) = INITIAL WATER COL. CHEM CONC., CLASS 1 (COHESIVE) (ug/l) C CHEMI(2) = INITIAL WATER COL. CHEM CONC., CLASS 2 (NON-COHESIVE) (ug/l) C NCHEMLAY = NO. OF LAYERS IN CHEM BED MODEL (EXCLUDING SURFACE LAYER) C CHEMTHIK = THICKNESS OF LAYERS IN CHEM BED MODEL (cm) C CHEMACT = ACTIVE LAYER THICKNESS (cm) C C CHEMDRAT1 = PARTICLE-BOUND CHEMICAL DECAY RATE (1/day), CLASS 1 C CHEMDRAT2 = PARTICLE-BOUND CHEMICAL DECAY RATE (1/day), CLASS 2 C C C COHESIVE PARTICLE-BOUND TRACER C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN READ (IUT404,11) (COM(I),I = 1,80) READ (IUT404,5030)CHEMI(1),NCHEMLAY,CHEMTHIK,CHEMACT,CHEMDRAT1 5030 FORMAT (F10.0,I10,4F10.0) ENDIF C C NON-COHESIVE PARTICLE-BOUND TRACER C IF (SEDTYPE.EQ.'SAND'.OR.SEDTYPE.EQ.'BOTH') THEN READ (IUT405,11) (COM(I),I = 1,80) READ (IUT405,5030)CHEMI(2),NCHEMLAY,CHEMTHIK,CHEMACT,CHEMDRAT2 C IF (SEDTYPE.EQ.'SAND') CHEMI(1)=CHEMI(2) ENDIF C C CONVERT DECAY RATE FROM 1/day TO 1/s C CHEMDRAT1=CHEMDRAT1/86400. CHEMDRAT2=CHEMDRAT2/86400. C C CALC. NUMBER OF LAYERS IN ACTIVE LAYER C NACTLAY=NINT(CHEMACT/CHEMTHIK) C C INPUT INITIAL CHEM BED CONCENTRATIONS (ug CHEM/g SOLIDS) C If (RESTAR.EQ.'COLD START') Then OPEN (UNIT=85,FILE='bed_chemic',FORM='FORMATTED') DO 5029 N=1,NCHEMLAY DO 5029 I=1,IM READ (85,5028) (CBEDCHEM(N,I,J),J=1,JM) 5028 FORMAT (10F8.0) 5029 CONTINUE CLOSE (85) ENDIF C C CONVERT FROM ug/l TO ug/cm**3 C CHEMI(1)=CHEMI(1)/1000. CHEMI(2)=CHEMI(2)/1000. C ENDIF C C*********************************************************** C C FOR PARTICLE TRACKING C C NFREQ = FREQUENCY OF PARTICLE RELEASE (timesteps) C NPART = NUMBER OF PARTICLES PER RELEASE C NCONV = TOTAL NUMBER OF RELEASES BEFORE CONVERSION OF PARTICLES C TO CONCENTRATION (timesteps) C C NOTE: TOTAL NO. OF PARTICLES IN SYSTEM = NPART * NCONV C C IRELST = BEGINNING TIMESTEP OF PARTICLE RELEASE C NPCLASS = NUMBER OF PARTICLE CLASSES C C NSOURCE = NO. OF SOURCES OF PARTICLES C C isource = i of particle input C jsource = j of particle input C ksource = k-level of particle input, for testing only C IF (PARTICLE.EQ.'INCLUDE') THEN C Read (IUT406,11) (COM(I),I = 1,80) WRITE (IUPRT,11) (COM(I),I = 1,80) READ (IUT406,5810)NFREQ,NPART,IRELST,IRELEND, + NSOURCE NCONV=(IRELEND-IRELST)/NFREQ+1 ! nkim 061098 WRITE (IUPRT,5810)NFREQ,NPART,NCONV,IRELST,IRELEND, + NSOURCE 5810 FORMAT (9I8) C DO 5809 MM=1,NSOURCE READ (IUT406,5901)ISOURCE(MM),JSOURCE(MM),KSOURCE(MM) WRITE (IUPRT,5901)ISOURCE(MM),JSOURCE(MM),KSOURCE(MM) 5809 CONTINUE 5901 FORMAT (9I8) C IF (NPART.GT.NPARTM) THEN WRITE (IUPRT,5811)NPART,NPARTM 5811 FORMAT (/5X,'EXECUTION STOPPED BECAUSE NPART > NPARTM,' + /6X,'NPART =',I6,3X,'NPARTM =',I6, + /6X,'PLEASE SET NPART <= NPARTM AND RESUBMIT') STOP ENDIF C IF (NCONV.GT.NCONVM) THEN WRITE (IUPRT,5812)NCONV,NCONVM 5812 FORMAT (/5X,'EXECUTION STOPPED BECAUSE NCONV > NCONVM,' + /6X,'NCONV =',I6,3X,'NCONVM =',I6, + /6X,'PLEASE SET NCONV <= NCONVM AND RESUBMIT') STOP ENDIF C C C INTCONV = TIMESTEP AT WHICH TO INITIALLY START CONVERTING PARTICLES C TO CONSERVATIVE TRACER C INTCONV=NCONV*NFREQ+IRELST C C OPEN OUTPUT FILE FOR PARTICLES (TESTING ONLY) C OPEN (UNIT=32,FILE='part_location',FORM='FORMATTED') C ENDIF C C******************************************************************** C READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) c READ(IURUN,7) JHM,IAVGE c WRITE(IUPRT,7) JHM,IAVGE READ(IURUN,7101) JHM,AVGE,IPLTFORM,PLTZERO,OPTAVG,OFORM WRITE(IUPRT,710) JHM,AVGE,IPLTFORM,PLTZERO,OPTAVG,OFORM IF(OPTAVG.EQ.' '.OR.OPTAVG.EQ.'NDTI')THEN IAVGE=IFIX(AVGE) IPLTZERO=IFIX(PLTZERO) ELSE IF(OPTAVG.EQ.'HOUR') THEN IF(AMOD(AVGE*3600.0,DTI).NE.0.0) THEN WRITE(IUPRT,*)'AVERAGING INTERVAL IS NOT AN INTEGER MULTIPLE .OF DTI: PLEASE ADJUST AVGE AND RESUBMIT' STOP ELSE IAVGE=IFIX(AVGE*3600/DTI) IPLTZERO=IFIX(PLTZERO*3600/DTI) END IF ELSE IF(OPTAVG.NE.' '.OR.OPTAVG.NE.'HOUR' +.OR.OPTAVG.NE.'NDTI') THEN WRITE(IUPRT,*)'AVERAGING UNIT IS NOT SPECIFIED CORRECTLY' WRITE(IUPRT,*)'PLEASE CORRECT THIS AND RESUBMIT THE RUN' STOP END IF C gcmplt output format (either regular binary or netCDF format) IF (OFORM.EQ.'CDF'.OR.OFORM.EQ.'cdf') THEN CDFOUT = .TRUE. WRITE(IUPRT,*)'netCDF output is on' ELSE CDFOUT = .FALSE. WRITE(IUPRT,*)'Regular binary gcmplt output is on' END IF WRITE(IUPRT,*)'CDFOUT was set to ',CDFOUT 710 FORMAT(I10,F10.3,6X,A4,F10.2,1X,A4,2X,A3) 7101 FORMAT(I10,F10.0,6X,A4,F10.0,1X,A4,2X,A3) IF(JHM.EQ.0) GO TO 200 IF(JHM.GT.IHISTM) THEN WRITE(IUPRT,60) JHM,IHISTM CALL SYSTEM ('rm gcm_temp*') STOP ENDIF 60 FORMAT(//' JHM (=',I4,') MUST BE LESS THAN OR EQUAL TO'/ . ' IHISTM (=',I4,') SPECIFIED IN COMDECK'/ . ' PLEASE FIX AND RESUBMIT'//) C DEI=1./FLOAT(IAVGE) IF(IPLTFORM.EQ.' '.OR.IPLTFORM.EQ.'USER')THEN READ(IURUN,6) (IHIST(I,2),I=1,JHM) ELSE IF(IPLTFORM.EQ.'AUTO')THEN DO I=1,JHM IHIST(I,2)=IPLTZERO+I*IAVGE END DO ELSE IF(IPLTFORM.NE.' '.AND.IPLTFORM.NE.'USER'.AND. . IPLTFORM.NE.'AUTO') THEN WRITE(IURUN,*)'YOUR SETTING FOR GCMPLT OUTPUT IS INCORRENT' WRITE(IURUN,*)'YOU SPECIFIED IPLTFFORM AS ',IPLTFORM STOP END IF WRITE(IUPRT,6) (IHIST(I,2),I=1,JHM) 7 FORMAT(8I10) 6 FORMAT(10I8) C 200 READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) READ(IURUN,7) ISKILL WRITE(IUPRT,7) ISKILL IF(ISKILL.EQ.0) THEN SKILLI=1.0 GO TO 203 ELSE SKILLI=1./FLOAT(ISKILL) ENDIF READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) READ(IURUN,5) EPTS WRITE(IUPRT,5) EPTS 5 FORMAT(16I5) IF(EPTS.EQ.0) GO TO 201 IF(EPTS.GT.EPTSM) THEN WRITE(IUPRT,61) EPTS,EPTSM CALL SYSTEM ('rm gcm_temp*') STOP ENDIF 61 FORMAT(//' EPTS (=',I4,') MUST BE LESS THAN OR EQUAL TO'/ . ' EPTSM (=',I4,') SPECIFIED IN COMDECK'/ . ' PLEASE FIX AND RESUBMIT'//) C READ(IURUN,5) (INXIE(I),INXJE(I),I=1,EPTS) WRITE(IUPRT,5) (INXIE(I),INXJE(I),I=1,EPTS) 201 READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) READ(IURUN,5) VPTS WRITE(IUPRT,5) VPTS IF(VPTS.EQ.0) GO TO 202 IF(VPTS.GT.VPTSM) THEN WRITE(IUPRT,62) VPTS,VPTSM CALL SYSTEM ('rm gcm_temp*') STOP ENDIF 62 FORMAT(//' VPTS (=',I4,') MUST BE LESS THAN OR EQUAL TO'/ . ' VPTSM (=',I4,') SPECIFIED IN COMDECK'/ . ' PLEASE FIX AND RESUBMIT'//) C READ(IURUN,5) (INXIV(I),INXJV(I),I=1,VPTS) WRITE(IUPRT,5) (INXIV(I),INXJV(I),I=1,VPTS) 202 READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) READ(IURUN,5) FPTS WRITE(IUPRT,5) FPTS IF(FPTS.EQ.0) GO TO 203 IF(FPTS.GT.FPTSM) THEN WRITE(IUPRT,63) VPTS,VPTSM CALL SYSTEM ('rm gcm_temp*') STOP ENDIF 63 FORMAT(//' FPTS (=',I4,') MUST BE LESS THAN OR EQUAL TO'/ . ' FPTSM (=',I4,') SPECIFIED IN COMDECK'/ . ' PLEASE FIX AND RESUBMIT'//) C READ(IURUN,49) (ISFLX(N),JSFLX(N),DIRFLX(N),NFLXE(N),N=1,FPTS) WRITE(IUPRT,49) (ISFLX(N),JSFLX(N),DIRFLX(N),NFLXE(N),N=1,FPTS) 49 FORMAT(4(2I5,1X,A4,I5)) C 203 READ(IURUN,11) (COM(I),I=1,80) WRITE(IUPRT,12) (COM(I),I=1,80) c READ(IURUN,7101) JHM,AVGE,IPLTFORM,PLTZERO,OPTAVG READ(IURUN,7102) JTM,AVGE,ITRNFORM,TRNZERO,OPTAVG,IWET 7102 FORMAT(I10,F10.0,6X,A4,F10.0,1X,A4,I5) IF(OPTAVG.EQ.' '.OR.OPTAVG.EQ.'NDTI')THEN NPLPF=IFIX(AVGE) IZERO=IFIX(TRNZERO) ELSE IF(OPTAVG.EQ.'HOUR')THEN IF(AMOD(AVGE*3600.0,DTI).NE.0.0)THEN WRITE(IUPRT,*)'AVERAGING INTERVAL FOR GCM_TRAN IS NOT AN INTEG .ER MULTIPLE OF DTI: PLEASE ADJUST AVGE AND RESUBMIT' STOP ELSE NPLPF=IFIX(AVGE*3600/DTI) IZERO=IFIX(TRNZERO*3600/DTI) END IF ELSE IF(OPTAVG.NE.' '.OR.OPTAVG.NE.'HOUR' . .OR.OPTAVG.NE.'NDTI')THEN WRITE(IUPRT,*)'AVERAGING UNIT IS SPECIFIED INCORRECTLY' WRITE(IUPRT,*)'PLEASE CORRECT THIS AND RESUBMIT THE RUN' STOP END IF WRITE(IUPRT,7103) JTM,NPLPF,ITRNFORM,IZERO,IWET 7103 FORMAT(2I10,6X,A4,2I10) IF(IWET.EQ.0)THEN WRITE(IUPRT,*)'WQ INFO FOR ENTIRE GRID OPTION SELECTED' ELSE WRITE(IUPRT,*)'WQ INFO FOR WET-GRID OPTION SELECTED' END IF IF(ITRNFORM.EQ.' '.OR.ITRNFORM.EQ.'USER') . WRITE(IUPRT,*)'USER SPECIFIED TIME BREAKS FOR DUMP USED' IF(ITRNFORM.EQ.'AUTO') . WRITE(IUPRT,*)'ECOM WILL GENERATE THE TIME BREAKS VIA JTM,NPLPF, . AND IZERO' IF(JTM.EQ.0) GO TO 204 IF(JTM.GT.ITRACM) THEN WRITE(IUPRT,64) JTM,ITRACM CALL SYSTEM ('rm gcm_temp*') STOP ENDIF 64 FORMAT(//' JTM (=',I4,') MUST BE LESS THAN OR EQUAL TO'/ . ' ITRACM (=',I4,') SPECIFIED IN COMDECK'/ . ' PLEASE FIX AND RESUBMIT'//) C FLTWT=1./FLOAT(NPLPF) IF(ITRNFORM.EQ.' '.OR.ITRNFORM.EQ.'USER')THEN READ(IURUN,6) (ITRAC(I,2),I=1,JTM) ELSE DO I=1,JTM ITRAC(I,2)=IZERO+I*NPLPF END DO END IF WRITE(IUPRT,6) (ITRAC(I,2),I=1,JTM) 204 CONTINUE C IF(TOR.NE.'BAROTROPIC' .AND. TOR.NE.'PROGNOSTIC' .AND. . TOR.NE.'TEMP_ONLY '.AND.TOR.NE.'SALT_ONLY '.AND. . TOR.NE.'DIAGNOSTIC') THEN WRITE(IUPRT,24) TOR 24 FORMAT(//' TYPE OF RUN (TOR=',A10,') IS SPECIFIED INCORRECTLY',/ . ' PLEASE FIX AND RESUBMIT'//) CALL SYSTEM ('rm gcm_temp*') STOP END IF C IF (ADVECT.NE.'LINEAR ' .AND. ADVECT.NE.'NON-LINEAR') THEN WRITE(IUPRT,25) ADVECT 25 FORMAT(//' TYPE OF MOMENTUM ADVECTION (ADVECT=',A10,') IS', .'SPECIFIED INCORRECLTY',/' PLEASE FIX AND RESUBMIT'//) CALL SYSTEM ('rm gcm_temp*') STOP END IF C IF(SCHEME.NE.'CENTRAL ' .AND. SCHEME.NE.'UPWIND ' .AND. . SCHEME.NE.'SMOLAR_R ' .AND. SCHEME.NE.'SMOLAR_2 ') THEN WRITE(IUPRT,34) SCHEME 34 FORMAT(//' T&S ADVECTION SCHEME (SCHEME=',A10,') IS SPECIFIED', . ' INCORRECTLY',/' PLEASE FIX AND RESUBMIT'//) CALL SYSTEM ('rm gcm_temp*') STOP END IF C IF (HORZMIX.NE.'CLOSURE ' .AND. HORZMIX.NE.'CONSTANT ') THEN WRITE(IUPRT,26) HORZMIX 26 FORMAT(//' TYPE OF HORIZONTAL MIXING (HORZMIX=',A10,') IS', . ' SPECIFIED INCORRECTLY',/ . ' PLEASE FIX AND RESUBMIT'//) CALL SYSTEM ('rm gcm_temp*') STOP END IF C IF (VERTMIX.NE.'CLOSURE ' .AND. VERTMIX.NE.'CONSTANT '.AND. . VERTMIX.NE.'EMPIRICAL ') THEN WRITE(IUPRT,27) VERTMIX 27 FORMAT(//' TYPE OF VERTICAL MIXING (VERTMIX=',A10,') IS', . ' SPECIFIED INCORRECTLY',/ . ' PLEASE FIX AND RESUBMIT'//) CALL SYSTEM ('rm gcm_temp*') STOP END IF C cqa IF (ITRAC(1,2).NE.0 .AND. NPLPF.NE.0) THEN cqa IF (RESTAR.NE.'HOT START ' .AND. TOR.NE.'BAROTROPIC' .AND. cqa . ITRAC(1,2).EQ.NPLPF) THEN cqa WRITE(IUPRT,28) ITRAC(1,2),NPLPF,RESTAR,TOR cqa 28 FORMAT(//' THE FIRST TRANSPORT COMPUTATION INTERVAL (ITRAC)',I10,/ cqa . ' CANNOT BE EQUAL TO THE NUMBER OF POINTS IN NPLPF',I10,/ cqa . ' IN A ',A10,' 3-DIMENSIONAL (',A10,') RUN',/ cqa . ' PLEASE FIX AND RESUBMIT'//) cqa CALL SYSTEM ('rm gcm_temp*') cqa STOP cqa END IF cqa END IF C IF(TOR.EQ.'BAROTROPIC') THEN WRITE(IUPRT,14) TOR ELSE WRITE(IUPRT,13) TOR END IF 13 FORMAT(/' THIS IS A THREE DIMENSIONAL MODEL RUN',2X,A10/) 14 FORMAT(/' THIS IS A TWO DIMENSIONAL MODEL RUN',2X,A10/) C WRITE(IUPRT,22) ADVECT 22 FORMAT(/' THIS SIMULATION HAS ',A10,' MOMENTUM ADVECTION '/) C WRITE(IUPRT,222) SCHEME 222 FORMAT(/' THIS SIMULATION USES ',A10,' DIFFERENCING FOR T&S'/) C IF(HORZMIX.EQ.'CLOSURE ') THEN WRITE(IUPRT,29) HORZMIX,HORCON,HPRNU ELSE WRITE(IUPRT,31) HORZMIX,HORCON,HPRNU END IF 29 FORMAT(/' THIS SIMULATION HAS ',A10,' HORIZONTAL MIXING ', . ' HORCON = ',1PE10.3,' HPRNU = ',1PE10.3/) 31 FORMAT(/' THIS SIMULATION HAS ',A10,' HORIZONTAL MIXING ', . ' CONSTANT = ',1PE10.3,'m**2/s HPRNU = ',1PE10.3/) C IF(VERTMIX.EQ.'CLOSURE ') THEN WRITE(IUPRT,32) VERTMIX,UMOL,VPRNU ELSE WRITE(IUPRT,33) VERTMIX,UMOL,VPRNU END IF 32 FORMAT(/' THIS SIMULATION HAS ',A10,' VERTICAL MIXING ', . ' UMOL = ',1PE10.3,' VPRNU = ',1PE10.3/) 33 FORMAT(/' THIS SIMULATION HAS ',A10,' VERTICAL MIXING ', . ' CONSTANT = ',1PE10.3,'m**2/s VPRNU = ',1PE10.3/) C CALL ZEROES(ADVUA,ADVVA,ADVUU,ADVVV,DRHOX,DRHOY,TRNU,TRNV) C CNG01052010 SET SOME PARAMETERS FOR PRINTING/SAVING ACCORDINGLY CNG01052010 (MOVED THEM FROM PUTCDF TO COMDECK) CNG save wave output IF(WAVEDYN.NE.'NEGLECT')THEN PTWAVE = 'Y' CNG WRITE(IUPRT,'A') 'Enabling WAVE printing and saving' ELSE PTWAVE = 'N' END IF CNG IF(RESTAR.EQ.'COLD START') THEN CALL SETDOM chli INTX_HOT = INTX ! NG09212011 FOR MULTIPLE RESTARTS IF COLD START ISTART=INTX+1 IEND=INTX+NSTEPS chli CALL BCDATA(RESTAR) CALL TANDS CALL DENS CALL ARCHIVE !NG03182010 FIX COLD-START IC AVERAGING (STILL NO PRINTING, IF NO AVERAGING) ELSE OPEN (IURRS,FORM='unformatted',FILE='restart') CQA CQA IF RUN TYPE "HOT START" AND "EXTERNAL" and IWET is 1 then "WET GRID" CQA IF(HYDTYPE.EQ.'EXTERNAL'.AND.IWET.EQ.1) . CALL SETDOM C CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ C C NO HOT START CAPABILITY FOR PARTICLE TRACKING (C.K.Z. 4/22/96) C CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ C IF (TRACER.EQ.'INCLUDE') THEN IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ENDIF ENDIF ELSE IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF (WAVEDYN.EQ.'NEGLECT') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN READ (IURRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli c write(*,*)'HOT READ, INTX,T,S,U,V=', c .T(20,10,1),S(20,10,1),U(20,10,1),V(20,10,1) ENDIF ENDIF ENDIF csfan csfan hot start time step c INTX_HOT = INTX write(*,*)'HOT READ, INTX', INTX_HOT IF(VERTMIX.EQ.'CONSTANT ') UMOL=0.0 ! NG03182010 OTHERWISE HOTSTART ISSUE, BECAUSE UMOL->KH C C******************************************************************** C C FOR PARTICLE TRACKING (corner_loc INPUT IN setdom FOR COLD START) C IF (PARTICLE.EQ.'INCLUDE') THEN IRELST=IRELST+INTX C C OPEN CORNER LOCATIONS FILE C C CORNER LOCATION CONVENTION: XCOR(I,J) = x(i-1/2, j-1/2) C (LOWER LEFT-HAND CORNER) YCOR(I,J) = y(i-1/2, j-1/2) C OPEN (UNIT=33,FILE='corner_loc',FORM='FORMATTED') C DO 2300 N=1,1000000 READ (33,*,END=2310)I,J,XCOR(I,J),YCOR(I,J) 2300 CONTINUE C C CALC. H1 AND H2 AT ELEMENT INTERFACES C 2310 DO 2320 J=1,JM DO 2320 I=1,IM H1P(I,J)=SQRT((XCOR(I+1,J)-XCOR(I,J))**2.+ + (YCOR(I+1,J)-YCOR(I,J))**2.) C H2P(I,J)=SQRT((XCOR(I,J+1)-XCOR(I,J))**2.+ + (YCOR(I,J+1)-YCOR(I,J))**2.) 2320 CONTINUE CLOSE(33) ENDIF C C********************************************************************* C CLOSE (IURRS) chli ISTART=INTX+1 IEND=INTX+NSTEPS chli c SDAY=SDAY+FLOAT(INTX)*DAYI*DTI ! NKIM (11/06/01) c EDAY=SDAY+TNDAYS ! NKIM (11/06/01) EDAY=SDAY+TNDAYS+FLOAT(INTX)*DAYI*DTI C RESET IYR,IMO,IDA FOR PTIDE IF HOT START !hli (04/04/01) CNGCAREFUL:NEEDS STARTING HOUR FOR THIS RUN HOUR=AMOD(SDAY,1.0)*24.0 HOUR=AMOD(AMOD(SDAY,1.0)+FLOAT(INTX)*DAYI*DTI,1.0)*24 ! CNG CNG04212008 IHOUR1=IFIX(HOUR) IHOUR1=NINT(HOUR) ! To the closest hour for rounding errors. c KD=JINT(SDAY) csvv KD=JINT(SDAY+FLOAT(INTX)*DAYI*DTI) KD=SDAY+FLOAT(INTX)*DAYI*DTI CALL CDAY(IDA1,IMO1,IYR1,KD,2) chli TMP_IYR=IYR TMP_IMO=IMO TMP_IDA=IDA TMP_IHOUR=IHOUR c IYR=IYR1 IMO=IMO1 IDA=IDA1 IHOUR=IHOUR1 chli WRITE(IUPRT,211) IYR,IMO,IDA,IHOUR CALL BCDATA(RESTAR) chli IYR=TMP_IYR IMO=TMP_IMO IDA=TMP_IDA IHOUR=TMP_IHOUR chli ENDIF call RDCORLOC ! NG04242009 CNG HARDWIRE CNG DO I=73,108 CNG DO J=3,5 CNG H1(I,J)=H1(I,6) CNG H2(I,J)=H2(I,6) CNG ANG(I,J)=ANG(I,6) CNG COR(I,J)=2.*7.292E-5*SIN(COR(I,6)*2.*3.141593/360.)*FSM(I,J) CNG ENDDO CNG ENDDO CNG DO I=73,108 CNG DO J=3,5 CNG ART(I,J)=H1(I,J)*H2(I,J) CNG ARU(I,J)=.25E0*(H1(I,J)+H1(I-1,J))*(H2(I,J)+H2(I-1,J)) CNG ARV(I,J)=.25E0*(H1(I,J)+H1(I,J-1))*(H2(I,J)+H2(I,J-1)) CNG ENDDO CNG ENDDO CNG HARDWIRE C C INITIALIZE SEDIMENT TRANSPORT VARIABLES C IF (SEDTRAN.EQ.'INCLUDE') CALL SEDIC(RESTAR) C C********************************************************************** C IF(OPTBFRIC.EQ.'MANNINGS-N')THEN CALL UPDATE_CBCM ! CNG2014 Manning's N ELSE CALL UPDATE_CBC ! CNG04262011 MOVED TO SUBROUTINE TOO !!! ENDIF CNG04262011 Do 6030 J = 1, JM CNG04262011 Do 6020 I = 1, IM CNG04272010 W&D BASED ON H1 If (H(I,J).GT.0.0) Then CNG04272010 W&D AND A MINIMUM DEPTH OF 10cm IS ALLOWED FOR CBC CALCULATION. CNG04262011 If (FSM(I,J).NE.0.0) Then C C VARIABLE BOTTOM FRICTION FOR SEDIMENT TRANSPORT C CNG04262011 IF (SEDTRAN.EQ.'INCLUDE') THEN C C COHESIVE ELEMENTS C CNG04262011 IF (IBMSK(I,J).EQ.0) THEN CNG04262011 Z0 = Z0BCOH CNG04262011 CBCMIN = BFCOH CNG04262011 IF (TOR.EQ.'BAROTROPIC') THEN CNG04262011 CBC(I,J)=BFCOH*FSM(I,J) CNG04262011 ELSE cqa CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((ZZ(KBM1)-Z(KB))* CNG04262011 CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((DZ(KBM1)*0.5)* CNG04262011 + AMAX1(DT(I,J),1.E-1,WETMIN)/Z0)**2)*FSM(I,J) ! NG W&D CNG04262011 ENDIF C C NON-COHESIVE ELEMENTS C CNG04262011 ELSE CNG04262011 Z0 = Z0B CNG04262011 CBCMIN = BFRIC CNG04262011 IF (TOR.EQ.'BAROTROPIC') THEN CNG04262011 CBC(I,J)=BFRIC*FSM(I,J) CNG04262011 ELSE cqa CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((ZZ(KBM1)-Z(KB))* CNG04262011 CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((DZ(KBM1)*0.5)* CNG04262011 + AMAX1(DT(I,J),1.E-1,WETMIN)/Z0)**2)*FSM(I,J) ! NG W&D CNG04262011 ENDIF CNG04262011 ENDIF CNG04262011 ELSE CNG04262011 Z0 = Z0B CNG04262011 CBCMIN = BFRIC CNG04262011 IF (TOR.EQ.'BAROTROPIC') THEN CNG04262011 CBC(I,J)=BFRIC*FSM(I,J) CNG04262011 ELSE cqa CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((ZZ(KBM1)-Z(KB))* CNG04262011 CBC(I,J)=AMAX1(CBCMIN,.16/ALOG((DZ(KBM1)*0.5)* CNG04262011 + AMAX1(DT(I,J),1.E-1,WETMIN)/Z0)**2)*FSM(I,J) ! NG W&D CNG04262011 ENDIF CNG04262011 ENDIF CNG04262011 END IF CNG04262011 CBC(I,J) = AMIN1(CBC(I,J)*VARBF(I,J),1.) ! FACTOR IN 2D VARIABLE BFRIC, AND DO NOT ALLOW CBC TO EXCEED UNITY. CNG04232008 IF(VARBF(I,J).GT.0.0)WRITE(IUPRT,*)'VARBF',VARBF(I,J) CNG04262011 IF(VARBF(I,J).NE.1.)WRITE(IUPRT,*)'VARBF',VARBF(I,J) CNG04262011 6020 CONTINUE CNG04262011 6030 CONTINUE C C SET INITIAL TRACER CONCENTRATIONS C IF (TRACER.EQ.'INCLUDE'.AND.RESTAR.EQ.'COLD START') THEN IF(TRICOPT.NE.'DATA ')THEN DO 6034 K=1,KBM1 DO 6034 J=2,JMM1 DO 6034 I=2,IMM1 CNG IF (H(I,J).GT.0.0) THEN IF (H1(I,J).GT.0.0) THEN ! BASE IT ON H1 CONC1(I,J,K)=CONINIT CONC1B(I,J,K)=CONINIT ENDIF 6034 CONTINUE ELSE OPEN(402,FILE='init_tracer',STATUS='OLD') DO N=1,IM*JM READ(402,'(2I5,100F5.0)',END=6033)I,J,(CONC1(I,J,K),K=1,KB) END DO 6033 WRITE(IUPRT,*)'NUM OF CONS. TRACER INITIAL CONDITION',N-1 DO K=1,KBM1 DO J=2,JMM1 DO I=2,IMM1 CONC1B(I,J,K)=CONC1(I,J,K) END DO END DO END DO END IF ENDIF C C SET INITIAL SEDIMENT CONCENTRATIONS C IF (SEDTRAN.EQ.'INCLUDE'.AND.RESTAR.EQ.'COLD START') THEN DO 6035 K=1,KBM1 DO 6035 J=2,JMM1 DO 6035 I=2,IMM1 CNG IF (H(I,J).GT.0.0) THEN IF (H1(I,J).GT.0.0) THEN ! BASE IT ON H1 IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN CSED1(I,J,K)=CSI(1) CSED1B(I,J,K)=CSI(1) ENDIF C IF (SEDTYPE.EQ.'SAND') THEN CSED2(I,J,K)=CSI(1) CSED2B(I,J,K)=CSI(1) ELSE CSED2(I,J,K)=CSI(2) CSED2B(I,J,K)=CSI(2) ENDIF ENDIF 6035 CONTINUE ENDIF C C*********************************************************** C C CHEM TRANSPORT C IF (CHEMTRAN.EQ.'INCLUDE'.AND.RESTAR.EQ.'COLD START') THEN C C SET: 1. INITIAL CHEM WATER COLUMN CONCENTRATIONS (ug/cm**3) C 2. INITIAL CHEM MASS IN BED LAYERS (ug CHEM/cm**2) C 3. INITIAL SEDIMENT MASS IN BED LAYERS (g solids/cm**2) C DO 36 K=1,KBM1 DO 36 J=2,JMM1 DO 36 I=2,IMM1 CNG IF (H(I,J).GT.0.0) THEN IF (H1(I,J).GT.0.0) THEN ! BASE IT ON H1 IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN CHEM1(I,J,K)=CHEMI(1) CHEM1B(I,J,K)=CHEMI(1) ENDIF C IF (SEDTYPE.EQ.'SAND') THEN CHEM2(I,J,K)=CHEMI(1) CHEM2B(I,J,K)=CHEMI(1) ELSE CHEM2(I,J,K)=CHEMI(2) CHEM2B(I,J,K)=CHEMI(2) ENDIF ENDIF 36 CONTINUE C DO 37 N=1,NCHEMLAY DO 37 J=1,JM DO 37 I=1,IM IF (FSM(I,J).GT.0.0) THEN SEDMASS(N,I,J)=CBED(I,J)*CHEMTHIK C C TOP LAYER IS INITIALLY VERY THIN C cpl 02/24/00 IF (N.EQ.1) SEDMASS(N,I,J)=0.001*SEDMASS(N,I,J) IF (N.EQ.1) SEDMASS(N,I,J)=0.0 CHEMMASS(N,I,J)=SEDMASS(N,I,J)*CBEDCHEM(N,I,J) ELSE CBEDCHEM(N,I,J)=0.0 cpl add next two lines SEDMASS(N,I,J)=0.0 CHEMMASS(N,I,J)=0.0 ENDIF 37 CONTINUE ENDIF C C*********************************************************** C C CALC. FETCH & MEAN DEPTH FOR WIND WAVE MODEL C IF (WAVEDYN.EQ.'SMBMODEL') CALL FHCALC C C INPUT INITIAL FLOW FIELD FROM gcm_tran C IF (HYDTYPE.EQ.'EXTERNAL') THEN OPEN (IUTRN,FORM='unformatted',FILE='gcm_tran') NHYDCNT=0 CALL TRANINP(0) ENDIF C C******************************************************************* C C IF(RESTAR.EQ.'COLD START') CALL PRINTS(DRHOX,DRHOY,TRNU,TRNV) C IRELEND=IRELEND+INTX !hli c ISTART=INTX+1 chli TNDAYS=FLOAT(NSTEPS)*DAYI*DTI IEND=INTX+NSTEPS CQA SEDIMENT RUNS 1 AVERAGING PERIOD LESS THAN HYDRODYNAMICS Quamrul 10/1/98 CQA IF (HYDTYPE.EQ.'EXTERNAL') THEN CQA IEND=IEND - NPLPF-1 CQA ENDIF TPRT=FLOAT(IPRINT)*DAYI*DTI TAVG=FLOAT(IAVGE)*DAYI*DTI TSKILL=FLOAT(ISKILL)*DAYI*DTI TRACE=FLOAT(NPLPF)*DAYI*DTI DO 16 I=1,JHM IHIST(I,2)=INTX+IHIST(I,2) 16 IHIST(I,1)=IHIST(I,2)-IAVGE+1 DO 18 I=1,JTM ITRAC(I,2)=INTX+ITRAC(I,2) 18 ITRAC(I,1)=ITRAC(I,2)-NPLPF+1 C WRITE(IUPRT,15) ISTART,IEND 15 FORMAT(//30H MODEL STARTING UP...ISTART = ,I6,8H IEND = ,I6/) csvv KD=JINT(EDAY) KD=EDAY WRITE(IUPRT,*)'SDAY AND EDAY',SDAY,EDAY CALL CDAY(IDAE,IMOE,IYRE,KD,2) c CALL CDAY(IDAE,IMOE,IYRE,KD,IIDINT(2.D0)) WRITE(IUPRT,210)IYR,IMO,IDA,IYRE,IMOE,IDAE 210 FORMAT('SIMULATION FROM',I5,2I3,4X,'TO',3X,I5,2I3) !hli WRITE(IUPRT,20) TNDAYS 20 FORMAT(//32H NUMBER OF DAYS IN SIMULATION = ,F6.2/) WRITE(IUPRT,30) TPRT,IPRINT,IPRTSTART,TAVG,IAVGE,TSKILL,ISKILL 30 FORMAT(//' TPRT = ',F10.3,' IPRINT = ',I10, . ' IPRTSTART = ',I10,// . ' TAVG = ',F10.3,' IAVGE = ',I10,// . ' TSKILL = ',F10.3,' ISKILL = ',I10,//) WRITE(IUPRT,35) WRITE(IUPRT,40) (IHIST(I,1),IHIST(I,2),I=1,JHM) 35 FORMAT(//' HISTORY TAKEN AT TIMESTEPS START ----- STOP ') 40 FORMAT(27X,I8,3X,I8) WRITE(IUPRT,47) WRITE(IUPRT,48) (ITRAC(I,1),ITRAC(I,2),I=1,JTM) 47 FORMAT(//' QUALITY PARAMETERS FOR RCA INTEGRATED OVER TIMESTEPS . START STOP') 48 FORMAT(57X,I8,2X,I8) C WRITE(IUPRT,41)BFRIC,OPTZ0B,NU,THETA,ALPHA,TLAG,NWAVE, . BCTYPE,OPTBFRIC 41 FORMAT(//' BFRIC = ',F10.4,' nondimensional'/ . ' Z0B = ',A10,' m'/ . ' NU = ',F10.4,' nondimensional'/ . ' THETA = ',F10.4,' nondimensional'/ . ' ALPHA = ',F10.4,' nondimensional'/ . ' TLAG = ',F10.4, . ' FRICTION TIME SCALE in PCLAMP BC (Hours)'/ . ' WAVE MODEL ACTIVATED EVERY = ',I10, ' Time Steps'/ . ' BOUNDARY TYPE = ',3x,A7/ . ' BOTTOM FRICTION IS = ',A10/) C TLAG=TLAG*3600+1.0e-10 ! CONVERT TO SECONDS IF(TLAG.GT.0)TLAG=1./TLAG ALPHA=ALPHA*3600 ! CONVERT TO SECONDS IF(ALPHA.GT.0)ALPHA=1./ALPHA cqa WRITE(IUPRT,70) 70 FORMAT(/1X,' K',6X,'Z',10X,'ZZ',8X,'DZ',/) DO 90 K=1,KBM1 WRITE(IUPRT,80) K,Z(K),ZZ(K),DZ(K) 90 CONTINUE WRITE(IUPRT,80) K,Z(KB) 80 FORMAT(I3,3F10.3) C THOUR=FLOAT(INTX)*DTI/3600. CALL FIRST C AREA=0.0 EMI=0.0 APEI=0.0 DO 280 J=1,JM DO 280 I=1,IM 280 AREA=AREA+FSM(I,J)*ART(I,J) DO 285 K=1,KBM1 DO 285 J=1,JM DO 285 I=1,IM TRHO=(RMEAN(I,J,K)+1.)*1000. CNG W&D VOL=H(I,J)*ART(I,J)*DZ(K) VOL=D(I,J)*ART(I,J)*DZ(K) EMI=EMI+TRHO*VOL*FSM(I,J) CNG W&D 285 APEI=APEI+GRAV*TRHO*ZZ(K)*H(I,J)*VOL*FSM(I,J) 285 APEI=APEI+GRAV*TRHO*ZZ(K)*D(I,J)*VOL*FSM(I,J) WRITE(IUPRT,85) AREA,EMI,APEI 85 FORMAT(// . ' SURFACE AREA ',1PE14.7,' m**2 ',//, . ' INITIAL MASS ',1PE14.7,' Kg ',//, . ' INITIAL AVAILABLE POTENTIAL ENERGY ',1PE14.7,' joules',//) * * INITIALIZE TBDRY2 AND SBDRY2 Khan 080999 ******* NEW VARIABLES FOR USE IN antidif.f Khan 080999 * DO N = 1, NUMEBC IE = IETA(N) JE = JETA(N) DO K = 1, KBM1 C TBDRY2(N,K) = TB(IE,JE,K) C SBDRY2(N,K) = SB(IE,JE,K) TBDRY2(N,K) = T(IE,JE,K) SBDRY2(N,K) = S(IE,JE,K) ENDDO ENDDO * ******* NEW VARIABLES FOR USE IN antidif.f Khan 080999 * C RMarsooli_August2015, Mellor's wave model C time step for surface wave modules = dtw. isplitw=2 !ISPLIT dtw=NWAVE*DTI/isplitw !dtw=(isplit/isplitw)*dte dth=2.*3.1416/float(mmm-2) !WAVE propagation angle increment C Constants for Smolarkiewicz iterative upstream scheme. C Number of iterations. This should be in the range 1 - 4. 1 is C standard upstream differencing; 3 adds 50% CPU time to POM: nitera=2 C C----------------------------------------------------------------------- C C BEGIN NUMERICAL INTEGRATION C C----------------------------------------------------------------------- C DO 9000 INTX=ISTART,IEND C c RAMP=TANH(FLOAT(INTX)/FLOAT(IRAMP+1)) IF(INTX.GT.IRAMP) then RAMP=1.0 else c print *, 'WHY THE HELL ARE WE HERE?' RAMP = FLOAT(INTX)/FLOAT(IRAMP) ! stop divide by zero bug! dbk endif TIME=FLOAT(INTX)*DAYI*DTI THOUR=TIME*24. C C WAVE EFFECTS ON BOTTOM FRICTION (HYDRODYNAMICS ONLY) C CALL BCOND(7,DTI2,0) C C*******RMarsooli_August2015, MELLOR ET AL.'S WAVE MODEL******************** IF(WAVEDYN.EQ.'MELLOR') THEN NWAVECNT=NWAVECNT+1 if(NWAVECNT.EQ.1) then c do j=1,jm c do i=1,im c do k=1,kb c tpx(i,j,k)=tpx0(i,j)*tpzdist(i,j,k) c tpy(i,j,k)=tpy0(i,j)*tpzdist(i,j,k) c Sxx(i,j,k)=0.0 c Syy(i,j,k)=0.0 c Sxy(i,j,k)=0.0 c ust(i,j,k)=0.0 c vst(i,j,k)=0.0 c enddo c enddo c enddo CALL BCOND(11,DTI2,0) !BOUNDARY CONDITION FOR WAVE MODEL do nwavemel=1,isplitw call wavemdo(dtw,dth,nwavemel) enddo C C STORE WAVE DATA, SAME FORMAT AS sECOM AND DONELAN WAVE MODEL DO J=1,JM DO I=1,IM WVHT(I,J)=0.0 SIG(I,J)=0.0 WVDR(I,J)=0.0 WVPD(I,J)=0.0 WN(I,J)=0.0 IF(FSMW(I,J).GT.0.) THEN WVHT(I,J)=Hs(I,J) !SIGNIFICANT WAVE HEIGHT (M) SIG(I,J)=0.25*WVHT(I,J) !WAVE HEIGHT STANDARD DEVIATION (M) WVPD(I,J)=(6.2832/sigthav(I,J)) !AVERAGE WAVE PERIOD (S) WN(I,J)=kthav(I,J) !AVERAGE WAVE NUMBER (1/S) ccomment "thtav" is wave direction w.r.t. true east, toward, c counterclockwise:+, clockwise:- ccomment "WVDR" is wave direction w.r.t. true north, toward, c always positive (clockwise) ccc WVDR_temp1=(thtav(I,J)+ANG(I,J))*180./3.1416 !True east,toward,counterclockwise:+, clockwise:- ccc if(WVDR_temp1.GT.180.) WVDR_temp1=WVDR_temp1-360. Ccomment calculate wave direction w.r.t true east, toward, only clockwise WVDR_temp1=thtav(I,J)*180./3.1416 WVDR_temp2=-WVDR_temp1 if(WVDR_temp1.GT.0.) WVDR_temp2=360.-WVDR_temp1 Ccomment calculate wave direction w.r.t true north, toward, only clockwise WVDR(I,J)=WVDR_temp2+90. if(WVDR(I,J).GT.360.) WVDR(I,J)= WVDR(I,J)-360. cc WVDR_temp=(thtav(I,J)+ANG(I,J))*180./3.1416 !True east, toward cc WVDR(I,J)=360.-WVDR_temp+90. cc IF(WVDR_temp.LE.90.) WVDR(I,J)=90.-WVDR_temp ENDIF ENDDO ENDDO endif IF (NWAVECNT.EQ.NWAVE) NWAVECNT=0 else do j=1,jm do i=1,im do k=1,kb tpx(i,j,k)=0.0 tpy(i,j,k)=0.0 Sxx(i,j,k)=0.0 Syy(i,j,k)=0.0 Sxy(i,j,k)=0.0 enddo enddo enddo endif C******************************************************************** C CNKIM11232010 NWAVECNT IS NOW IN BOTTAU (and comdeck) CNKIM11232010 IF (WAVEDYN.EQ.'SMBMODEL'.OR. CNKIM11232010 .WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'EXTERNAL') THEN CNKIM11232010CNG02222007 .WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'EXTERNAL') THEN CNKIM11232010 NWAVECNT=NWAVECNT+1 CNKIM11232010 IF (NWAVECNT.EQ.NWAVE) THEN CNKIM11232010 CALL BCOND(11,DTI2,0) CNKIM11232010 NWAVECNT=0 IF(OPTBFRIC.EQ.'MANNINGS-N')THEN CALL UPDATE_CBCM ! CNG2014 Manning's N ELSE CALL UPDATE_CBC ! NG 2014; move it here, from BOTTAU, and just call it before BOTTAU ENDIF C C RMarsooli, AUGUST_2015 cc IF(WAVEDYN.EQ.'MELLOR') THEN cc if(NWAVECNT.EQ.0) CALL BED_STRESS !WAVE-CURRENT INDUCED STRESS cc ELSE CALL BOTTAU !compute shear stress using currents+wave cc ENDIF CNKIM11232010 ENDIF CNKIM11232010 ELSE CNKIM11232010 CALL BOTTAU ! compute shear stress using currents only CNKIM11232010 ENDIF C CNG04152008 IF (WAVEDYN.EQ.'DONONLY') THEN CALL ARCHIVE GOTO 9910 ENDIF IF (HYDTYPE.EQ.'EXTERNAL') THEN C C Like Hydrodynamics skip first time step QA 9/25/98 C C NHYDCNT=NHYDCNT+1 IF(INTX.EQ.1) GO TO 8200 !hli C C INPUT NEW FLOW FIELD C IF (NHYDCNT.GT.NHYD) THEN cqa write(*,*)'INTX,NHYDCNT,NHYD=',INTX,NHYDCNT,NHYD cqa write(*,*)'INTX,NHYDCNT,NHYD=',INTX,NHYDCNT,NHYD CALL TRANINP(1) NHYDCNT=1 ENDIF C cqa CALL BCOND(7,DTI2,0) C C SKIP HYDRODYNAMICS C GOTO 9900 ENDIF C C IF(TOR.NE.'BAROTROPIC') THEN C CALL BAROPG(DRHOX,DRHOY,TRNU,TRNV,SGW) C C DO 50 J=1,JM DO 50 I=1,IM TRNU(I,J)=TRNU(I,J) +ADVUU(I,J)-ADVUA(I,J) 50 TRNV(I,J)=TRNV(I,J) +ADVVV(I,J)-ADVVA(I,J) C DO 120 J=1,JM DO 120 I=1,IM 120 EGF(I,J)=EL(I,J)*ISPI DO 400 J=2,JM DO 400 I=2,IM UTF(I,J)=UA(I,J)*(D(I,J)+D(I-1,J))*ISP2I VTF(I,J)=VA(I,J)*(D(I,J)+D(I,J-1))*ISP2I 400 CONTINUE C ENDIF IF(HORZMIX.EQ.'CLOSURE ') CALL SMAG !CNG MOVE UP HERE, BEFORE DUMWAD,DVMWAD IS RESET FOR NEXT EXTERNAL IF(WETLAND.EQ.'INCLUDE'.AND.TOR.NE.'BAROTROPIC') .CALL VEGFORCE !RMarsooli_Jan2015 DO 130 J=1,JM DO 130 I=1,IM DHMWAD(I,J)=FSM(I,J) ! RMarsooli_June2015 DUMWAD(I,J)=DUM(I,J) ! NG09292011 DVMWAD(I,J)=DVM(I,J) ! NG09292011 130 CONTINUE c!!!!!!!!!!!!!! CALL WALLFRIC !RMarsooli_Jan2015 C CNG IF(HORZMIX.EQ.'CLOSURE ') CALL SMAG C C----------------------------------------------------------------------- C BEGIN EXTERNAL MODE C----------------------------------------------------------------------- C DO 8000 IEXT=1,ISPLIT C cpl CALL EXTRNL(ADVUA,ADVVA,TRNU,TRNV,DTE2,BFRIC,DTI2) CALL EXTRNL(ADVUA,ADVVA,TRNU,TRNV,DTE2,DTI2) IF(TOR.EQ.'BAROTROPIC') GO TO 440 IF(IEXT.LT.(ISPLIT-2)) GO TO 440 IF(IEXT.EQ.(ISPLIT-2)) THEN DO 402 J=1,JM DO 402 I=1,IM 402 ETF(I,J)=.25*NU*ELF(I,J) GO TO 440 ENDIF IF(IEXT.EQ.(ISPLIT-1)) THEN DO 404 J=1,JM DO 404 I=1,IM 404 ETF(I,J)=ETF(I,J)+.5*(1.-.5*NU)*ELF(I,J) GO TO 440 ENDIF IF(IEXT.EQ.(ISPLIT-0)) THEN DO 406 J=1,JM DO 406 I=1,IM 406 ETF(I,J)=(ETF(I,J)+.5*ELF(I,J))*FSM(I,J) ENDIF 440 CONTINUE C----------------------------------------------------------------------- C APPLY FILTER TO REMOVE TIME SPLIT AND RESET TIME SEQUENCE C----------------------------------------------------------------------- C DO 150 J=1,JM DO 150 I=1,IM UA(I,J)=UA(I,J)+.5*NU*(UAB(I,J)-2.*UA(I,J)+UAF(I,J)) VA(I,J)=VA(I,J)+.5*NU*(VAB(I,J)-2.*VA(I,J)+VAF(I,J)) 150 EL(I,J)=EL(I,J)+.5*NU*(ELB(I,J)-2.*EL(I,J)+ELF(I,J)) IF(TOR.EQ.'BAROTROPIC') THEN DO 155 JTRAC=1,JTM IF(INTX.GE.ITRAC(JTRAC,1).AND.INTX.LE.ITRAC(JTRAC,2)) + CALL TRANSPORT 155 CONTINUE END IF DO 160 J=1,JM DO 160 I=1,IM CNG DUMWAD(I,J)=DUM(I,J) ! NG05192010 CNG DVMWAD(I,J)=DVM(I,J) ! NG05192010 ELB(I,J)=EL(I,J) EL(I,J)=ELF(I,J) D(I,J)=H(I,J)+EL(I,J) UAB(I,J)=UA(I,J) UA(I,J)=UAF(I,J) VAB(I,J)=VA(I,J) 160 VA(I,J)=VAF(I,J) C C C INTRODUCE WET/DRY SCHEME BASED ON KKY's DISSERTATION (hli, 08/03/05). C CALL WANDD_KKY(EL,D) C C TEST FOR MODEL BLOWUP. IF SO, PRINT AND STOP C VAMAX=-1.E10 DO 442 J=1,JM DO 442 I=1,IM VMAXTMP=SQRT((0.5*DUMWAD(I,J)*UAF(I,J)+ . 0.5*DUMWAD(I+1,J)*UAF(I+1,J))**2+ . (0.5*DVMWAD(I,J)*VAF(I,J)+ . 0.5*DVMWAD(I,J+1)*VAF(I,J+1))**2) IF(VMAXTMP.GE.VAMAX) THEN IAMAX=I JAMAX=J VAMAX=VMAXTMP END IF 442 CONTINUE CNG write(*,*) 'Max Cur:',TIME,IAMAX,JAMAX,VAMAX,ELF(IAMAX,JAMAX) CNG write(*,*)'Wave/am:',WVHT(IAMAX,JAMAX),AAM2D(IAMAX,JAMAX) IF(VAMAX.GT.100.) GO TO 9100 cstart, check elevation minimum, jeff Ji, 1/17/96 C elevation ELMINX=1.E10 DO 443 J=1,JM DO 443 I=1,IM cwad elminx=1.0+elf(i,j)*fsm(i,j)/(h(i,j)+1.0e-5) cwad IF(elminx.lt.0.1) THEN ! 10 percent !! IF(ELF(I,J).LT.ELMINX.AND.FSM(I,J).NE.0.) THEN IAMAX=I JAMAX=J cwad elmin=elf(I,J) ELMINX=ELF(I,J) cwad go to 9100 cwad write(*,*) 'Max:',TIME,IAMAX,JAMAX,VAMAX,ELF(IAMAX,JAMAX) END IF C Khan cwad IF(elminx.lt.0.20) THEN ! 20 percent !! Warning cwad IAMAX=I cwad JAMAX=J cwad elmin=elf(I,J) cwad WRITE(IUPRT,7501)IAMAX,JAMAX,elmin,TIME cwad END IF 443 CONTINUE CNG write(*,*)'MinElev:',TIME,IAMAX,JAMAX,ELMINX,ELMINX+H(IAMAX,JAMAX) cend, check elevation minimum, jeff ji, 1/17/96 IF(TOR.EQ.'BAROTROPIC') GO TO 8000 IF(IEXT.EQ.ISPLIT) GO TO 8000 DO 445 J=1,JM DO 445 I=1,IM 445 EGF(I,J)=EGF(I,J)+EL(I,J)*ISPI DO 450 J=2,JM DO 450 I=2,IM UTF(I,J)=UTF(I,J)+UA(I,J)*(D(I,J)+D(I-1,J))*ISP2I 450 VTF(I,J)=VTF(I,J)+VA(I,J)*(D(I,J)+D(I,J-1))*ISP2I C 8000 CONTINUE C C----------------------------------------------------------------------- C END EXTERNAL (2-D) MODE CALCULATION C AND CONTINUE WITH INTERNAL (3-D) MODE CALCULATION C----------------------------------------------------------------------- C IF(INTX.EQ.1) GO TO 8200 !hli cqa IF(INTX.EQ.1)THEN cqa DO 305 JTRAC=1,JTM cqa IF(INTX.GE.ITRAC(JTRAC,1).AND.INTX.LE.ITRAC(JTRAC,2)) cqa . CALL TRANSPORT cqa 305 CONTINUE cqa GO TO 8200 cqa ENDIF C IF (TOR.EQ.'BAROTROPIC') THEN CALL ARCHIVE GO TO 9900 END IF C C----------------------------------------------------------------------- C ADJUST U(Z) AND V(Z) SUCH THAT C VERTICAL AVERAGE OF (U,V) = (UA,VA) C----------------------------------------------------------------------- C DO 299 J=1,JM DO 299 I=1,IM 299 TPS(I,J)=0.0 DO 300 K=1,KBM1 DO 300 J=2,JM DO 300 I=2,IM 300 TPS(I,J)=TPS(I,J)+U(I,J,K)*DZ(K) DO 302 K=1,KBM1 DO 302 J=2,JM DO 302 I=2,IM 302 U(I,J,K)=( (U(I,J,K)-TPS(I,J))+ . (UTB(I,J)+UTF(I,J))/(DT(I,J)+DT(I-1,J)) ) DO 303 J=1,JM DO 303 I=1,IM 303 TPS(I,J)=0.0 DO 304 K=1,KBM1 DO 304 J=2,JM DO 304 I=2,IM 304 TPS(I,J)=TPS(I,J)+V(I,J,K)*DZ(K) DO 306 K=1,KBM1 DO 306 J=2,JM DO 306 I=2,IM 306 V(I,J,K)=( (V(I,J,K)-TPS(I,J))+ . (VTB(I,J)+VTF(I,J))/(DT(I,J)+DT(I,J-1)) ) C C-------- CORRECT FOR RIVER BOUNDARY CONDITIONS ------------------------ DO 320 N=1,NUMQBC ID=IQD(N) JD=JQD(N) IC=IQC(N) JC=JQC(N) DO 320 K=1,KBM1 IF(JD.EQ.JC) THEN IF(ID.LT.IC) THEN IF(VQDIST(N,K).EQ.0.0) U(IC,JC,K)=0.0 ELSE IF(VQDIST(N,K).EQ.0.0) U(ID,JD,K)=0.0 ENDIF ELSE IF(JD.LT.JC) THEN IF(VQDIST(N,K).EQ.0.0) V(IC,JC,K)=0.0 ELSE IF(VQDIST(N,K).EQ.0.0) V(ID,JD,K)=0.0 ENDIF ENDIF 320 CONTINUE C C----------------------------------------------------------------------- C CALCULATE HORIZONTAL MASS FLUXES, (H2*U*D) AND (H1*V*D) C----------------------------------------------------------------------- DO 310 K=1,KBM1 DO 311 J=2,JMM1 DO 311 I=2,IM XMFL3D(I,J,K)=0.25*(H2(I-1,J)+H2(I,J))*(DT(I-1,J)+DT(I,J))* . U(I,J,K) 311 CONTINUE DO 312 J=2,JM DO 312 I=2,IMM1 YMFL3D(I,J,K)=0.25*(H1(I,J-1)+H1(I,J))*(DT(I,J-1)+DT(I,J))* . V(I,J,K) 312 CONTINUE 310 CONTINUE C C----------------------------------------------------------------------- C VERTVL INPUT = U,V,DT(=H+ET),ETF,ETB; OUTPUT = W C----------------------------------------------------------------------- CALL VERTVL(DTI2) CALL BCOND(5,DTI2,0) DO 307 JTRAC=1,JTM IF(INTX.GE.ITRAC(JTRAC,1).AND.INTX.LE.ITRAC(JTRAC,2)) + CALL TRANSPORT 307 CONTINUE ** ** MOVED TO BE CONSITENT WITH ecom3d Khan 080999 CALL ARCHIVE ** MOVED TO BE CONSITENT WITH ecom3d Khan 080999 ** C C----------------------------------------------------------------------- C COMPUTE Q2F AND Q2LF USING UF AND VF AS TEMPORARY VARIABLES C----------------------------------------------------------------------- C IF(VERTMIX.EQ.'CLOSURE ') THEN CALL ADVQ(Q2B,Q2,DTI2,UF,1) !1 IS ADDED BY RMarsooli_Jan2015 CALL ADVQ(Q2LB,Q2L,DTI2,VF,2) !2 IS ADDED BY RMarsooli_Jan2015 CALL PROFQ(DTI2) CALL BCOND(6,DTI2,0) DO 325 K=1,KB DO 325 J=1,JM DO 325 I=1,IM Q2 (I,J,K)=Q2 (I,J,K)+.5*NU*(UF(I,J,K)+Q2B(I,J,K)-2.*Q2(I,J,K)) Q2B(I,J,K)=Q2(I,J,K) Q2(I,J,K)=UF(I,J,K) 325 CONTINUE DO 335 K=1,KB DO 335 J=1,JM DO 335 I=1,IM Q2L(I,J,K)=Q2L(I,J,K)+.5*NU*(VF(I,J,K)+Q2LB(I,J,K)- . 2.*Q2L(I,J,K)) Q2LB(I,J,K)=Q2L(I,J,K) Q2L(I,J,K)=VF(I,J,K) 335 CONTINUE END IF IF(VERTMIX.EQ.'EMPIRICAL ')CALL PROFE C C----------------------------------------------------------------------- C COMPUTE UPDATED BOTTOM FRICTION (CBC) EVERY TIMESTEP C----------------------------------------------------------------------- C C----------------------------------------------------------------------- C COMPUTE TF AND SF USING UF AND VF AS TEMPORARY VARIABLES C----------------------------------------------------------------------- C * ******* CHANGES FOR antidif.f BC Khan 080999 IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'TEMP_ONLY ') CC . CALL ADVT(TB,T,TMEAN,DTI2,UF,TDIF,TDIS,TBDRY) !ORIGINAL . CALL ADVT(TB,T,TMEAN,DTI2,UF,TDIF,TDIS,TBDRY2) IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'SALT_ONLY ') CC . CALL ADVT(SB,S,SMEAN,DTI2,VF,SDIF,SDIS,SBDRY) !ORIGINAL . CALL ADVT(SB,S,SMEAN,DTI2,VF,SDIF,SDIS,SBDRY2) ******* CHANGES FOR antidif.f BC Khan 080999 * cqa cqa Modified by Quamrul QA for SWRAD penetration on 3/10/99 cqa IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'TEMP_ONLY ') . CALL PROFT(UF,WTSURF,DTI2,SWRAD) IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'SALT_ONLY ') . CALL PROFT(VF,WSSURF,DTI2,ZEROS) CALL BCOND(4,DTI2,0) cqa ******* NEW VARIABLES FOR USE IN antidif.f Khan 080999 * DO N = 1, NUMEBC IE = IETA(N) JE = JETA(N) DO K = 1, KBM1 TBDRY2(N,K) = UF(IE,JE,K) SBDRY2(N,K) = VF(IE,JE,K) ENDDO ENDDO * ******* NEW VARIABLES FOR USE IN antidif.f Khan 080999 IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'TEMP_ONLY ')THEN DO 345 K=1,KB DO 345 J=1,JM DO 345 I=1,IM T(I,J,K)=T(I,J,K)+.5*NU*(UF(I,J,K)+TB(I,J,K)-2.*T(I,J,K)) TB(I,J,K)=T(I,J,K) T(I,J,K)=UF(I,J,K) 345 CONTINUE ENDIF C cqa IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'SALT_ONLY ')THEN DO 355 K=1,KB DO 355 J=1,JM DO 355 I=1,IM S(I,J,K)=S(I,J,K)+.5*NU*(VF(I,J,K)+SB(I,J,K)-2.*S(I,J,K)) SB(I,J,K)=S(I,J,K) S(I,J,K)=VF(I,J,K) 355 CONTINUE CPL WRITE(4001,*)'INSIDE ECOM',INTX CPL WRITE(4001,'(8F10.3)')(S(IETA(N),JETA(N),1),N=1,NUMEBC) CPL WRITE(4001,'(8F10.3)')(VF(IETA(N),JETA(N),1),N=1,NUMEBC) ENDIF C IF(TOR.EQ.'PROGNOSTIC'.OR.TOR.EQ.'SALT_ONLY '.OR. . TOR.EQ.'TEMP_ONLY ')THEN CALL DENS END IF C C FOR CONSERVATIVE TRACER C 9900 IF (TRACER.EQ.'INCLUDE') THEN Cqa We Introduce a decay coefficient which is function of T,S and Io Cqa Based on Mancini 1978. Cqa K = kd + Ki + Ks Cqa Kd = decay rate as a function of T,S Cqa = (0.8 + 0.006*(% of sea water))*1.07**(t-20) Cqa Ki = decay rate due to irradiance Io Cqa = alpha*Io/(Ke*Z) [ 1-exp (-Ke*Z)] Cqa Ks = Vs/Z Cqa Cqa We define decay rate DKRATE(I,J,K) = DKD(I,J,K) + DKI(I,J,K) + DKS(I,J,K) Cqa DO 141 K=1,KBM1 DO 141 J=2,JMM1 DO 141 I=2,IMM1 IF(TROPT.EQ.'PATHOGEN ')THEN DKD(I,J,K) = (CONDRAT + 0.006*ASAL*(S(I,J,K)/35.0*100.))* . THETAT**(T(I,J,K)-20.) SOLRAD = SWRAD(I,J)*(-4.186E6) * 2.066115 /24.0 ! Langley/Hr DKI(I,J,K) = (ASOL*SOLRAD/(EXTC*(-ZZ(K))*DT(I,J)))* . (1.0-EXP(EXTC*ZZ(K)*DT(I,J))) DKS(I,J,K) = VSRATE/DT(I,J) DKRATE(I,J,K) = DKD(I,J,K) + DKI(I,J,K) + DKS(I,J,K) DKRATE(I,J,K) = DKRATE(I,J,K)/86400. ! rate to 1/sec ELSE IF(TROPT.EQ.'SIMPDECAY ')THEN DKRATE(I,J,K)=CONDRAT/86400. END IF 141 CONTINUE C CALL ADVCON(CONC1B,CONC1,CMEAN1,DTI2,UF,CDIF1,CDIS1,CBDRY1, + CPSTR) C CALL PROFT(UF,WCSURF,DTI2,ZEROS) CALL BCOND(8,DTI2,0) DO 346 K=1,KB DO 346 J=1,JM DO 346 I=1,IM CONC1(I,J,K)=CONC1(I,J,K)+.5*NU*(UF(I,J,K)+CONC1B(I,J,K)- + 2.*CONC1(I,J,K)) CONC1B(I,J,K)=CONC1(I,J,K) CONC1(I,J,K)=UF(I,J,K) 346 CONTINUE ENDIF C C******************************************************************** C C FOR PARTICLE TRACKING C IF (PARTICLE.EQ.'INCLUDE') THEN IF (INTX.GE.IRELST) THEN IF (INTX.EQ.IRELST) IDUM=-1 CALL PARTRAK(IDUM,IRELEND) ENDIF ENDIF C C******************************************************************** C C SEDIMENT TRANSPORT C IF (SEDTRAN.EQ.'INCLUDE'.AND.INTX.GT.NSEDBEG) THEN C cqa WHEN INTX=1 HYDRODYNAMIC SKIPS ie THIS SEGMENT SKIPS IF(INTX.EQ.2)NSEDCT=1 IF(INTX.EQ.2)N24CNT=1 NSEDCT=NSEDCT+1 N24CNT=N24CNT+1 C COHESIVE CLASS C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN DO 6300 N=1,NUMQBCSE DUMB1(N)=CDIS(1,N) 6300 CONTINUE C DO 6310 K=1,KBM1 DO 6310 N=1,NUMEBCSE DUMB2(N,K)=CBDRY(1,N,K) 6310 CONTINUE C C MODIFIED BY C.K.Z. ON 5/12/97 C C FOR DIFFUSER INPUTS C DO 6315 N=1,NUMDBCSE DUMB3(N)=CSDIFF(1,N) 6315 CONTINUE C c yang,08/31/99 C CALL ADVSED(CSED1B,CSED1,DTI2,UF,DUMB1,DUMB2,DUMB3,WSET1, C + WCT1BOT) CALL ADVSED(CSED1B,CSED1,DTI2,UF,DUMB1,DUMB2,DUMB3) C c CALL PROFSED(UF,DTI2) CALL PROFSED(UF,DTI2,WSET1,WCT1BOT) !! yang, 08/31/99 C CALL BCOND(9,DTI2,1) C DO 6320 K=1,KBM1 DO 6320 J=1,JM DO 6320 I=1,IM c yang start (dec/22/1999): set minimum of conc to prevent from creat mass. c CSED1(I,J,K)=CSED1(I,J,K)+.5*NU*(UF(I,J,K)+ c + CSED1B(I,J,K)-2.*CSED1(I,J,K)) IF (UF(I,J,K).LE. 0.0 )THEN WCT1BOT(I,J)=0.0 CSED1(I,J,K)=0.0 ELSE CSED1(I,J,K)=CSED1(I,J,K)+.5*NU*(UF(I,J,K)+ + CSED1B(I,J,K)-2.*CSED1(I,J,K)) ENDIF c yang end CSED1B(I,J,K)=CSED1(I,J,K) CSED1(I,J,K)=UF(I,J,K) 6320 CONTINUE ENDIF C 8900 Format (f8.3,I7,10F10.5) 9007 Format (2X,' (02,12) (03,11) . (03,12) (03,13)') C C NON-COHESIVE CLASS C IF (SEDTYPE.EQ.'SAND'.OR.SEDTYPE.EQ.'BOTH') THEN C IF (SEDTYPE.EQ.'SAND') THEN KK=1 ELSE KK=2 ENDIF C DO 6330 N=1,NUMQBCSE DUMB1(N)=CDIS(KK,N) 6330 CONTINUE C DO 6340 K=1,KBM1 DO 6340 N=1,NUMEBCSE DUMB2(N,K)=CBDRY(KK,N,K) 6340 CONTINUE C C MODIFIED BY C.K.Z. ON 5/12/97 C C FOR DIFFUSER INPUTS C DO 6345 N=1,NUMDBCSE DUMB3(N)=CSDIFF(KK,N) 6345 CONTINUE C c yang. 08/31/99 C CALL ADVSED(CSED2B,CSED2,DTI2,UF,DUMB1,DUMB2,DUMB3, C + WSET2,WCT2BOT) CALL ADVSED(CSED2B,CSED2,DTI2,UF,DUMB1,DUMB2,DUMB3) C C C CALL PROFSED(UF,DTI2) CALL PROFSED(UF,DTI2,WSET2,WCT2BOT) !! yang, 08/31/99 C CALL BCOND(9,DTI2,KK) C DO 6350 K=1,KBM1 DO 6350 J=1,JM DO 6350 I=1,IM c yang start (dec/22/1999): set minimum of conc to prevent from creat mass. c CSED2(I,J,K)=CSED2(I,J,K)+.5*NU*(UF(I,J,K)+ c + CSED2B(I,J,K)-2.*CSED2(I,J,K)) IF (UF(I,J,K).LE. 0.0 )THEN WCT2BOT(I,J)=0.0 CSED2(I,J,K)=0.0 ELSE CSED2(I,J,K)=CSED2(I,J,K)+.5*NU*(UF(I,J,K)+ + CSED2B(I,J,K)-2.*CSED2(I,J,K)) ENDIF c yang end CSED2B(I,J,K)=CSED2(I,J,K) CSED2(I,J,K)=UF(I,J,K) 6350 CONTINUE ENDIF C C CHECK IF MODEL IS BLOWING UP C C STOP PROGRAM IF CONC. > 100,000 mg/l (0.10 g/cm**3) C NBLOW=NBLOW+1 IF (NBLOW.EQ.100) THEN NBLOW=0 CMAX=0.10 DO 6360 J=3,JM-2 DO 6360 I=2,IM-1 IF (H(I,J).GT.0.01) THEN TOTCON=CSED1(I,J,1)+CSED2(I,J,1) IF (ABS(TOTCON).GT.CMAX) THEN WRITE (IUPRT,6370)INTX,I,J,CSED1(I,J,1),CSED2(I,J,1) 6370 FORMAT (/5X,'******* PROGRAM EXECUTION STOPPED AT', + I8,' TIMESTEP',/8X,'CONCENTRATION > 100,000 mg/l AT ',2I3,/8X, + 'C1 AND C2 =',2E12.4) WRITE (6,6380)TIME 6380 FORMAT (/5X,'$$$$ TIME (days) =',F10.4) C CALL PRINTS(DRHOX,DRHOY,TRNU,TRNV) C STOP ENDIF ENDIF 6360 CONTINUE ENDIF C C*********************************************************** C C CHEM TRANSPORT C IF (CHEMTRAN.EQ.'INCLUDE') THEN C C COHESIVE CLASS C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN DO 401 N=1,NUMQBCCH cpl 03/03/00 DUMB1(N)=CHEMDIS(1,N) DUMB1(N)=PDIS(1,N) 401 CONTINUE C DO 410 K=1,KBM1 DO 410 N=1,NUMEBCCH cpl 03/03/00 DUMB2(N,K)=CHEMBDRY(1,N,K) DUMB2(N,K)=PBDRY(1,N,K) 410 CONTINUE C C FOR DIFFUSER INPUTS Quamrul QA 5/25/99 C DO 415 N=1,NUMDBCCH DUMB3(N)=PDIFF(1,N) 415 CONTINUE C C CALL ADVCHEM(CHEM1B,CHEM1,DTI2,UF,DUMB1,DUMB2,DUMB3,WSET1, C + CHEMBOT1,CHEMDRAT1) CALL ADVCHEM(CHEM1B,CHEM1,DTI2,UF,DUMB1,DUMB2,DUMB3, + CHEMDRAT1) !! yang, 11/29/99 C C CALL PROFSED(UF,DTI2) CALL PROFSED(UF,DTI2,WSET1,CHEMBOT1) !! yang, 08/31/99 C CALL BCOND(10,DTI2,1) C DO 420 K=1,KBM1 DO 420 J=1,JM DO 420 I=1,IM c yang start (dec/22/1999): set minimum of conc to prevent from creat mass. c CHEM1(I,J,K)=CHEM1(I,J,K)+.5*NU*(UF(I,J,K)+ c + CHEM1B(I,J,K)-2.*CHEM1(I,J,K)) IF (UF(I,J,K).LE. 0.0 )THEN CHEMBOT1(I,J)=0.0 CHEM1(I,J,K)=0.0 ELSE CHEM1(I,J,K)=CHEM1(I,J,K)+.5*NU*(UF(I,J,K)+ + CHEM1B(I,J,K)-2.*CHEM1(I,J,K)) ENDIF c yang end CHEM1B(I,J,K)=CHEM1(I,J,K) CHEM1(I,J,K)=UF(I,J,K) 420 CONTINUE ENDIF C C NON-COHESIVE CLASS C IF (SEDTYPE.EQ.'SAND'.OR.SEDTYPE.EQ.'BOTH') THEN IF (SEDTYPE.EQ.'SAND') THEN KK=1 ELSE KK=2 ENDIF C DO 430 N=1,NUMQBCCH cpl 03/03/00 DUMB1(N)=CHEMDIS(KK,N) DUMB1(N)=PDIS(KK,N) 430 CONTINUE C DO 441 K=1,KBM1 DO 441 N=1,NUMEBCCH cpl 03/03/00 DUMB2(N,K)=CHEMBDRY(KK,N,K) DUMB2(N,K)=PBDRY(KK,N,K) 441 CONTINUE C C FOR DIFFUSER INPUTS Quamrul QA 5/25/99 C DO 439 N=1,NUMDBCCH DUMB3(N)=PDIFF(KK,N) 439 CONTINUE C C CALL ADVCHEM(CHEM2B,CHEM2,DTI2,UF,DUMB1,DUMB2,DUMB3,WSET2, C + CHEMBOT2,CHEMDRAT2) CALL ADVCHEM(CHEM2B,CHEM2,DTI2,UF,DUMB1,DUMB2,DUMB3, + CHEMDRAT2) !! yang, 11/29/99 C C CALL PROFSED(UF,DTI2) CALL PROFSED(UF,DTI2,WSET2,CHEMBOT2) !! yang, 08/31/99 C CALL BCOND(10,DTI2,KK) C DO 451 K=1,KBM1 DO 451 J=1,JM DO 451 I=1,IM c yang start (dec/22/1999): set minimum of conc to prevent from creat mass. c CHEM2(I,J,K)=CHEM2(I,J,K)+.5*NU*(UF(I,J,K)+ c + CHEM2B(I,J,K)-2.*CHEM2(I,J,K)) IF (UF(I,J,K).LE. 0.0 )THEN CHEMBOT2(I,J)=0.0 CHEM2(I,J,K)=0.0 ELSE CHEM2(I,J,K)=CHEM2(I,J,K)+.5*NU*(UF(I,J,K)+ + CHEM2B(I,J,K)-2.*CHEM2(I,J,K)) ENDIF c yang end CHEM2B(I,J,K)=CHEM2(I,J,K) CHEM2(I,J,K)=UF(I,J,K) 451 CONTINUE ENDIF ENDIF C C CALCULATE FLUXES AT SEDIMENT-WATER INTERFACE C cqa if(TIME.GE.18..AND.TIME.LE.20.) cqa .write(2001,*)'INTX,NSEDCT,NSBED=',INTX,NSEDCT,NSBED IF (NSEDCT.EQ.NSBED) THEN C C LIMIT DEPOSITION TO BATHYMETRIC DEPTH C PRAVI 08/12/99 C DO 459 J=1,JM DO 459 I=1,IM COHTHK(I,J) =0.0 NCOHTHK(I,J)=0.0 IF (IBMSK(I,J).EQ.0) THEN DO 458 LL=1,LAYMAX COHTHK(I,J)=COHTHK(I,J)+TSED(LL,I,J) 458 CONTINUE COHTHK(I,J)=COHTHK(I,J)/CBED(I,J) ELSE IF (IBMSK(I,J).EQ.1) THEN NCOHTHK(I,J)=NCOHTHK(I,J)+BEDTH(1,I,J) NCOHTHK(I,J)=100.*(NCOHTHK(I,J)/((CBED(I,J)/2.65)* + H1(I,J)*H2(I,J))) ENDIF ENDIF SEDTHK(I,J)=(COHTHK(I,J)+NCOHTHK(I,J))/100. 459 CONTINUE C C CALC. BOTTOM SHEAR STRESSES C cqa CALL BOTTAU C C COHESIVE BED MODEL C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') CALL SEDFLX C C NON-COHESIVE BED MODEL C IF (IBED.EQ.1) CALL SUSLOD C C CALCULATE CHEM FLUX AT SEDIMENT-WATER INTERFACE C IF (CHEMTRAN.EQ.'INCLUDE') THEN CALL CHEMFLX C C CHEM BED MODEL C CALL CHEMBED(CHEMDRAT1,CHEMDRAT2) ENDIF C NSEDCT=0 ENDIF C C*********************************************************** C C REORDER COHESIVE SEDIMENT BED LAYERS, IF NECESSARY C IF (SEDTYPE.EQ.'MUD '.OR.SEDTYPE.EQ.'BOTH') THEN IF (N24CNT.EQ.N24HR) CALL REORDR ENDIF ENDIF C C MODIFY ETA AND VELOCITIES FOR NEXT TIMESTEP (HYDRO INFO READ FROM hqi_tran) C IF (HYDTYPE.EQ.'EXTERNAL') THEN DO 9920 J=2,JMM1 DO 9920 I=2,IMM1 ETB(I,J)=ET(I,J) ET(I,J)=ETF(I,J) C ETF(I,J)=ETB(I,J)+2.*DTI*DETA(I,J) C DT(I,J)=H(I,J)+ET(I,J) 9920 CONTINUE C C CALC NEW VELOCITIES C DO 9930 K=1,KBM1 DO 9930 J=2,JMM1 DO 9930 I=2,IM U(I,J,K)=0.0 DBAR=0.25*(DT(I,J)+DT(I-1,J))*(H2(I-1,J)+H2(I,J)) IF (DBAR.GT.0.0) U(I,J,K)=XMFL3D(I,J,K)/DBAR 9930 CONTINUE C DO 9940 K=1,KBM1 DO 9940 J=2,JM DO 9940 I=2,IMM1 V(I,J,K)=0.0 DBAR=0.25*(DT(I,J)+DT(I,J-1))*(H1(I,J-1)+H1(I,J)) IF (DBAR.GT.0.0) V(I,J,K)=YMFL3D(I,J,K)/DBAR 9940 CONTINUE C C SKIP HYDRODYNAMICS IF READING FROM gcm_tran C GOTO 9910 ENDIF C IF (TOR.EQ.'BAROTROPIC') GO TO 9910 C C******************************************************************** C C----------------------------------------------------------------------- C COMPUTE UF AND VF C----------------------------------------------------------------------- C CALL ADVU(DRHOX,ADVUU,DTI2) CALL ADVV(DRHOY,ADVVV,DTI2) CALL PROFU(DTI2) CALL PROFV(DTI2) CALL BCOND(3,DTI2,0) C CJKL IF(BCTYPE.EQ.'MIXED ') CALL MIXED(2) CJKL C DO 369 J=1,JM DO 369 I=1,IM 369 TPS(I,J)=0.0 DO 370 K=1,KBM1 DO 370 J=1,JM DO 370 I=1,IM 370 TPS(I,J)=TPS(I,J)+(UF(I,J,K)+UB(I,J,K)-2.*U(I,J,K))*DZ(K) DO 372 K=1,KBM1 DO 372 J=1,JM DO 372 I=1,IM 372 U(I,J,K)=U(I,J,K)+.5*NU*(UF(I,J,K)+UB(I,J,K)-2.*U(I,J,K) . -TPS(I,J)) DO 373 J=1,JM DO 373 I=1,IM 373 TPS(I,J)=0.0 DO 374 K=1,KBM1 DO 374 J=1,JM DO 374 I=1,IM 374 TPS(I,J)=TPS(I,J)+(VF(I,J,K)+VB(I,J,K)-2.*V(I,J,K))*DZ(K) DO 376 K=1,KBM1 DO 376 J=1,JM DO 376 I=1,IM 376 V(I,J,K)=V(I,J,K)+.5*NU*(VF(I,J,K)+VB(I,J,K)-2.*V(I,J,K) . -TPS(I,J)) DO 377 K=1,KB DO 377 J=1,JM DO 377 I=1,IM UB(I,J,K)=U(I,J,K) U(I,J,K)=UF(I,J,K) VB(I,J,K)=V(I,J,K) 377 V(I,J,K)=VF(I,J,K) CNG write (*,*) time CNG write (*,*) U(143,6,1),U(144,6,1),U(145,6,1) CNG write (*,*) U(143,5,1),U(144,5,1),U(145,5,1) CNG write (*,*) U(143,4,1),U(144,4,1),U(145,4,1) CNG write (*,*) V(143,6,1),V(144,6,1),V(145,6,1) CNG write (*,*) V(143,5,1),V(144,5,1),V(145,5,1) CNG write (*,*) V(143,4,1),V(144,4,1),V(145,4,1) C C INTRODUCE WET/DRY SCHEME BASED ON KKY's DIISERTATION (hli,08/03/05). C cwad DO I=1,IMM1 DO J=2,JMM1 CNG02222011AFTERKIMUTF? IF(UA(I+1,J).EQ.0.0) THEN IF(UA(I+1,J).EQ.0.0) THEN ! ONLY WHEN AVERAGE OF EXTERNAL IS ZERO; FAT CHANCE THAT AVERAGE COMES TO EXACTLY ZERO. DO K=1,KBM1 U(I+1,J,K)=0.0 ENDDO ENDIF ENDDO ENDDO C DO I=2,IMM1 DO J=1,JMM1 CNG02222011AFTERKIMVTF? IF(VA(I,J+1).EQ.0.0) THEN IF(VA(I,J+1).EQ.0.0) THEN ! ONLY WHEN AVERAGE OF EXTERNAL IS ZERO; FAT CHANCE THAT AVERAGE COMES TO EXACTLY ZERO. DO K=1,KBM1 V(I,J+1,K)=0.0 ENDDO ENDIF ENDDO ENDDO C CALL WREAL(DTI2) C 8200 CONTINUE c DO 380 J=1,JM DO 380 I=1,IM EGB(I,J)=EGF(I,J) ETB(I,J)=ET(I,J) ET(I,J)=ETF(I,J) DT(I,J)=H(I,J)+ET(I,J) UTB(I,J)=UTF(I,J) 380 VTB(I,J)=VTF(I,J) CNG04232008 INITIALIZE QEPCNUDF FOR AVERAGING OF ELEVATION POTENTIAL Qs ! FOR EPC POTENTIAL DO N=1,NUMEPC QEPCNUDG(N)=QEPCNUDF(N) QEPCNUDF(N)=0.0 ENDDO CNG write (*,*) ET(143,6),ET(144,6),ET(145,6),ET(146,6) CNG write (*,*) ET(143,5),ET(144,5),ET(145,5),ET(146,5) CNG write (*,*) ET(143,4),ET(144,4),ET(145,4),ET(146,4) CNG write (*,*) ET(143,3),ET(144,3),ET(145,3),ET(146,3) CNG write (*,*) ET(143,2),ET(144,2),ET(145,2),ET(146,2) cwad cwad DO I=2,IMM1 cwad DO J=2,JMM1 cwad IF(DT(I,J).LE.WETMIN) THEN cwad DO K=1,KBM1 cwad U(I,J,K)=UTF(I,J) cwad V(I,J,K)=VTF(I,J) cwad ENDDO cwad ENDIF cwad ENDDO cwad ENDDO cwad Cwad cwad CALL WANDD_KKY(ET,DT,WETMIN,WETEPS) cwad C 9910 continue C C copied from ECOMSI, jeff ji , 1/31/94 ------------ C II = 23 C JJ = 55 c II = 31 c JJ = 10 c SPD1 = SQRT(.25*(U(II,JJ,1)+U(II+1,JJ,1))**2+.25*(V(II,JJ,1)+ c * V(II,JJ+1,1))**2) * 100. c ANG1 = ATAN2((V(II,JJ,1)+V(II,JJ+1,1)),(U(II,JJ,1)+ c * U(II+1,JJ,1)+1.E-10)) * 57.296 c SPD2 = SQRT(.25*(U(II,JJ,KBM1)+U(II+1,JJ,KBM1))**2+.25*( c * V(II,JJ,KBM1)+V(II,JJ+1,KBM1))**2) * 100. c ANG2 = ATAN2((V(II,JJ,KBM1)+V(II,JJ+1,KBM1)),(U(II,JJ,KBM1)+ c * U(II+1,JJ,KBM1)+1.E-10)) * 57.296 c IMOD = 1 c If (MOD(INTX,50*IMOD).EQ.0) Write (IUPRT,9006) c If (MOD(INTX,IMOD).EQ.0) Write (IUPRT,8900) time,INTX, 100. * c * ELF(II,JJ), SPD1, ANG1, SPD2, ANG2, S(II,JJ,1), c * S(II,JJ,KBM1), T(II,JJ,1), T(II,JJ,KBM1) cC c8900 Format (f8.3,I7,5F5.0,4F9.5) c9006 Format (2X,' DAYS TS ELE Usurf ANG Ubot ANG', c &' SSURF Sbot', c *' Tsurf Tbot ') C copied from ECOMSI, jeff ji , 1/31/94 ------------------ c ** MOVED ABOVE TO BE CONSITENT WITH ecom3d Khan 080999 cqa CALL ARCHIVE ** MOVED ABOVE TO BE CONSITENT WITH ecom3d Khan 080999 C IF(MOD(INTX,IPRINT).EQ.0 .AND. INTX.GE.IPRTSTART) THEN CALL PRINTS(DRHOX,DRHOY,TRNU,TRNV) ENDIF CNG Generate restart file at HRSRESTART HOURS CNG!!!!!!!! REMEMBER: WRITE STATEMENTS NEED INTX, NOT IEND FOR THIS !!!! CNG IF (NRESEND.GT.0) THEN IRESTART=INTX_HOT+HRSRESTART(NRESTART)*3600/DTI ELSE IRESTART=-1 ENDIF CNG WRITE(*,*) 'INTX=', INTX, 'IRESTART=', IRESTART IF (INTX.EQ.IRESTART) THEN IF (NRESEND.LE.1) THEN OPEN (IUWRS,FORM='unformatted',FILE='startup') ELSE STARTFL="startup.00" if (NRESTART.GT.9) THEN write (STARTFL(9:10),'(i2)') NRESTART else write (STARTFL(10:10),'(i1)') NRESTART endif OPEN (IUWRS,FORM='unformatted',FILE=STARTFL) ENDIF IF (INTX.NE.IEND) NRESTART=NRESTART+1 C IF (TRACER.EQ.'INCLUDE') THEN IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ENDIF ENDIF ELSE IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . INTX,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ENDIF ENDIF ENDIF C C******************************************************************** C CLOSE (IUWRS) C WRITE(*,*) 'RESTART FILE FINISHED, INTX=,IRESTART=',INTX,IRESTART endif 9000 CONTINUE C CNG GENERATE RESTART HERE ONLY IF REQUESTED AT END-OF-FILE IF (IEND.LE.IRESTART.OR.NRESEND.EQ.0) THEN IF (NRESEND.LE.1) THEN OPEN (IUWRS,FORM='unformatted',FILE='startup') ELSE STARTFL="startup.00" if (NRESTART.GT.9) THEN write (STARTFL(9:10),'(i2)') NRESTART else write (STARTFL(10:10),'(i1)') NRESTART endif OPEN (IUWRS,FORM='unformatted',FILE=STARTFL) ENDIF CNG C IF (TRACER.EQ.'INCLUDE') THEN IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + CONC1,CONC1B,N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ENDIF ENDIF ELSE IF (SEDTRAN.EQ.'NEGLECT') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE IF (CHEMTRAN.EQ.'INCLUDE') THEN chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED,CHEM1B,CHEM2B, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,CHEM1,CHEM2,CBEDCHEM,CHEMMASS, + SEDMASS,SEDEP, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ELSE chli IF(WAVEDYN.EQ.'NEGLECT') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ELSE CNG02222007 IF (WAVEDYN.EQ.'DONMODEL'.OR.WAVEDYN.EQ.'SMBMODEL') THEN IF (WAVEDYN(1:3).EQ.'DON'.OR.WAVEDYN.EQ.'SMBMODEL') THEN WRITE(IUWRS) . IEND,DZR,Z,ZZ,DZ,DZZ,H,H1,H2,D,DT,ANG, . ART,ARU,ARV,DUM,DVM,FSM,FSMW,COR,CURV42D,TXBOT,TYBOT, . UA,UAB,VA,VAB,EL,ELB,ETF,ET,ETB,EGF,EGB,UTF,UTB, . VTF,VTB,ADVUU,ADVVV,ADVUA,ADVVA,AAM2D,AAM,KM,KH,KQ,Q2,Q2B, . Q2L,Q2LB,L,U,UB,W,V,VB,T,TB,S,SB,RHO,RMEAN,TMEAN,SMEAN, . TDIF,SDIF, + N24CNT,LAYER,CSED1,CSED2,CSED1B,CSED2B, + TAUMAX,TAUCUR,TSED, + EBTOT,EBMAX,EBCUR,PSED1,PSED2,BEDTH,FRAC0,ACTLAY,CARMOR, + FR,NCNT,NHRCNT,NDTCNT,TAU, . XMOM,YMOM,CO,CS,SN,SIG,WN,NR ! NG FOR WAVES + ,VARWIF,AREAICE,TXICE,TYICE ! NG FOR ICE + ,DUMWAD,DVMWAD ! NGW&D ENDIF ENDIF chli ENDIF ENDIF ENDIF C******************************************************************** C CLOSE (IUWRS) CNG ENDIF CNG C 9100 CONTINUE CLOSE (IUT90) CLOSE (IUT91) CLOSE (IUT92) CLOSE (IUT93) CNG04092008 CLOSE (IUT193) CLOSE (IUT94) C IF (TRACER.EQ.'INCLUDE') THEN CLOSE (IUT96) CPL050800 CLOSE (IUT97) CLOSE (IUT98) CLOSE (IUT99) ENDIF C CPL 050800 IF (SEDTRAN.EQ.'INCLUDE') THEN CPL 050800 CLOSE (IUT101) CPL 050800 CLOSE (IUT102) CPL 050800 ENDIF C C******************************************************************** C CALL SYSTEM ('rm gcm_temp*') C C IF(VAMAX.LT.10.) THEN c IF(HYDTYPE.EQ.'EXTERNAL'.OR.(VAMAX.LT.10.and.elminx.gt.0.1)) THEN ! Ji, 1/17/96 IF(HYDTYPE.EQ.'EXTERNAL'.OR.(VAMAX.LT.10)) THEN ! Remove elminx for ! WAD (hli, 08/22/05) WRITE(IUPRT,602) TIME 602 FORMAT(/2X,'JOB SUCCESSFULLY COMPLETED; TIME = ',1P1E10.2,' DAYS', . //'PLEASE MAKE SURE YOUR RESULTS ARE PHYSICALLY CORRECT') C ELSE CALL PRINTS(DRHOX,DRHOY,TRNU,TRNV) WRITE(IUPRT,'(''*********************************************'')') WRITE(IUPRT,'(''************* ABNORMAL JOB END **************'')') WRITE(IUPRT,'(''************** RUN TERMINATED ***************'')') WRITE(IUPRT,'(''** PLEASE CHECK YOUR INPUTS AND PARAMETERS **'')') WRITE(IUPRT,'(''*********************************************'')') if(vamax.gt.10.0) .WRITE(IUPRT,7500)IAMAX,JAMAX,VAMAX,TIME,FSM(IAMAX,JAMAX) ! Ji, 1/17/96 7500 FORMAT(1X,'I=',I4,3X,'J=',I4,3X,'MAX SPEED=',E12.3,'TIME=', .F10.4,'FSM= ',f5.0) if(elminx.lt.0.1) .WRITE(IUPRT,7501)IAMAX,JAMAX,elmin,TIME,FSM(IAMAX,JAMAX) ! Ji, 1/17/96 7501 FORMAT(1X,'I=',I4,3X,'J=',I4,3X,'MIN ELEV=',E12.4,'TIME=', .F10.4,'FSM= ',f5.0) ENDIF C-------------------------------------------------------------------- 6110 FORMAT(/' BCTYPE = ',A7,', IS INCORRECTLY SPECIFIED.'// * ' PLEASE FIX AND RESUBMIT'//) 6111 FORMAT(/' BCTYPE = ',A7,' AND TLAG = ',F10.2, * ' ARE INCORRECTLY SPECIFIED.'// * ' PLEASE FIX AND RESUBMIT'//) 6112 FORMAT(/' WAVEDYN = ',A8,' IS INCORRECTLY SPECIFIED.'// * ' PLEASE FIX AND RESUBMIT'//) STOP END