From 5e694eed716d42cb5a15fc7e58ae4297fde9f075 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 6 Dec 2022 11:52:43 +0100 Subject: [PATCH 01/77] EFDC: Remove OpenMP parallelisation AIX version This removes OpenMP-based parallelisations that are present originating from the AIX-based versions. These are removed to make place for an updated, hybrid MPI & OpenMP approach. --- .../original_efdc_files/BAL2T3A.for | 62 +- .../original_efdc_files/BAL2T3B.for | 37 +- .../original_efdc_files/BAL2T4.for | 12 +- .../original_efdc_files/CALAVB.for | 49 +- .../original_efdc_files/CALAVBOLD.for | 22 +- .../original_efdc_files/CALBUOY.for | 24 +- .../original_efdc_files/CALCONC.for | 108 +--- .../original_efdc_files/CALEXP2T.for | 128 +--- .../original_efdc_files/CALFQC.for | 48 +- .../original_efdc_files/CALHDMF.for | 70 +-- .../original_efdc_files/CALHEAT.for | 74 +-- .../original_efdc_files/CALQQ2T.for | 121 ++-- .../original_efdc_files/CALQQ2TOLD.for | 116 ++-- .../original_efdc_files/CALQVS.for | 91 +-- .../original_efdc_files/CALTBXY.for | 121 +--- .../original_efdc_files/CALTRAN.for | 574 ++++-------------- .../original_efdc_files/CALTSXY.for | 20 +- .../original_efdc_files/CALUVW.for | 131 ++-- .../original_efdc_files/CALWQC.for | 41 +- .../original_efdc_files/CELLMAP.for | 6 + .../original_efdc_files/CONGRAD.for | 119 ++-- .../original_efdc_files/COSTRAN.for | 2 +- .../original_efdc_files/COSTRANW.for | 2 +- .../original_efdc_files/HDMT.for | 12 +- .../original_efdc_files/HDMT2T.for | 100 +-- .../original_efdc_files/READWIMS1.for | 2 +- .../original_efdc_files/RESTOUT.for | 2 +- 27 files changed, 521 insertions(+), 1573 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for index 5e2d629f2..172fbb362 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for @@ -12,7 +12,6 @@ C IMPLICIT NONE INTEGER::LD,K,L,NSX,NS,NWR,NCTL,ID,JD,KU,NT,M,JU,LU,KD,LL,NQSTMP INTEGER::IU,NCSTMP - INTEGER::LF,ithds REAL::RQWD IF(ISDYNSTP.EQ.0)THEN @@ -23,20 +22,12 @@ C C C ** ACCUMULATE INTERNAL SOURCES AND SINKS C -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(-:VOLOUT,WVOLOUT) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA VOLOUT=VOLOUT-DELT*(QSUME(L)-QDWASTE(L)) -c ENDDO -c DO L=2,LA + ENDDO + DO L=2,LA WVOLOUT=WVOLOUT-DELT*(QSUME(L)-QDWASTE(L)) ENDDO -c - enddo - DO K=1,KC DO LL=1,NQSIJ L=LQS(LL) @@ -45,19 +36,11 @@ c ENDDO ENDDO IF(ISTRAN(1).GE.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=SAL1(L,K) ENDDO ENDDO -c - enddo - DO NS=1,NQSIJ L=LQS(NS) NQSTMP=NQSERQ(NS) @@ -104,19 +87,11 @@ c ENDDO ENDIF IF(ISTRAN(3).GE.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=DYE1(L,K) ENDDO ENDDO -c - enddo - DO NS=1,NQSIJ L=LQS(NS) NQSTMP=NQSERQ(NS) @@ -176,18 +151,11 @@ c IF(ISTRAN(5).GE.1)THEN DO NT=1,NTOX M=MSVTOX(NT) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=TOX1(L,K,NT) ENDDO ENDDO -c - enddo C C TOXOUT2T(NT) IS NET TOXIC MASS GOING OUT OF DOMAIN DUE C TO WATER COLUMN VOLUME SOURCES AND SINKS @@ -241,18 +209,11 @@ C IF(ISTRAN(6).GE.1)THEN DO NSX=1,NSED M=MSVSED(NSX) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=SED1(L,K,NSX) ENDDO ENDDO -c - enddo C C SEDOUT2T(NSX) IS IS NET COHESIVE MASS GOING OUT OF DOMAIN DUE C TO WATER COLUMN VOLUME SOURCES AND SINKS @@ -306,18 +267,11 @@ C IF(ISTRAN(7).GE.1)THEN DO NSX=1,NSND M=MSVSND(NSX) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=SND1(L,K,NSX) ENDDO ENDDO -c - enddo C C SNDOUT2T(NSX) IS NET NONCOHESIVE MASS GOING OUT OF DOMAIN DUE C TO WATER COLUMN VOLUME SOURCES AND SINKS diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for index 0745a337b..7bb6498a9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for @@ -20,36 +20,21 @@ C C ** ACCUMULATE INTERNAL SOURCES AND SINKS C IF(IBALSTDT.EQ.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(-:WVOLOUT) -!$OMP& REDUCTION(+:BVOLOUT,VOLMORPH2T) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA WVOLOUT=WVOLOUT-DTSED*QMORPH(L) BVOLOUT=BVOLOUT+DTSED*QMORPH(L) VOLMORPH2T=VOLMORPH2T+DTSED*QMORPH(L) ENDDO -c - enddo ENDIF IF(ISTRAN(5).GE.1)THEN DO NT=1,NTOX M=MSVTOX(NT) WRITE(8,*)'NT M ',NT,M -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=TOX(L,K,NT) ENDDO ENDDO -c - enddo C C TOXBLB2T(NT) IS NET TOXIC MASS GOING OUT OF DOMAIN DUE C DUE TO BED LOAD TRANSPORT OUT OF DOMAIN @@ -79,18 +64,11 @@ C IF(ISTRAN(6).GE.1)THEN DO NSX=1,NSED M=MSVSED(NSX) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=SED(L,K,NSX) ENDDO ENDDO -c - enddo C C SEDFLUX2T(NSX) IS IS NET COHESIVE MASS FLUX POSITIVE FROM BED C TO WATER COLUMN @@ -105,18 +83,11 @@ C IF(ISTRAN(7).GE.1)THEN DO NSX=1,NSND M=MSVSND(NSX) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_2_LC(1,ithds) - LL=jse_2_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LC CONT(L,K)=SND(L,K,NSX) ENDDO ENDDO -c - enddo C C SBLOUT2T(NSX) IS NET NONCOHESIVE SEDIMENT MASS GOING OUT OF DOMAIN DU C DUE TO BED LOAD TRANSPORT OUT OF DOMAIN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for index 0add211ba..857fcdd9e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for @@ -17,13 +17,7 @@ C C C ** CALCULATE MOMENTUM AND ENERGY DISSIPATION C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN,DUTMP,DVTMP) -!$OMP& REDUCTION(+:UUEOUT,VVEOUT,BBEOUT) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA LN=LNC(L) UUEOUT=UUEOUT+0.5*DELT*SPB(L)*DXYP(L)*(U(L,1)*TBX(L) & +U(L+1,1)*TBX(L+1)-U(L,KC)*TSX(L)-U(L+1,KC)*TSX(L+1)) @@ -31,7 +25,7 @@ c & +V(LN,1)*TBX(LN)-V(L,KC)*TSY(L)-V(LN,KC)*TSX(LN)) ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) DUTMP=0.5*( U(L,K+1)+U(L+1,K+1)-U(L,K)-U(L+1,K) ) DVTMP=0.5*( V(L,K+1)+V(LN,K+1)-V(L,K)-V(LN,K) ) @@ -43,8 +37,6 @@ c & *GP*AB(L,K)*(B(L,K+1)-B(L,K)) ENDDO ENDDO -c - enddo RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for index b71b2cd04..ac5afa2d1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for @@ -31,23 +31,14 @@ C ABMIN=10. RIQMIN=-0.023 RIQMAX=0.28 -! -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -! DO K=1,KC - DO L=LF,LL + DO L=1,LC IF(IMASKDRY(L).EQ.1)THEN AV(L,K)=AVO*HPI(L) AB(L,K)=ABO*HPI(L) ENDIF ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO IF(ISFAVB.EQ.0)THEN DO K=1,KS DO L=2,LA @@ -85,17 +76,15 @@ C ENDDO ENDIF IF(ISFAVB.EQ.1)THEN -! -!$OMP PARALLEL DO PRIVATE(LF,LL,RIQ,SFAV,SFAB,ABTMP,AVTMP) -!$OMP& REDUCTION(max:AVMAX,ABMAX) REDUCTION(min:AVMIN,ABMIN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQI(L)=1./QQ(L,K) QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO + DO L=2,LA + IF(LMASKDRY(L))THEN RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) & *(B(L,K+1)-B(L,K))*QQI(L) RIQ=MAX(RIQ,RIQMIN) @@ -121,9 +110,6 @@ C ENDIF ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO ENDIF IF(ISFAVB.EQ.2)THEN DO K=1,KS @@ -159,29 +145,17 @@ C ENDIF ! *** NOW APPLY MAXIMUM, IF REQURIED IF(ISAVBMX.GE.1)THEN -! -!$OMP PARALLEL DO PRIVATE(LF,LL,ABTMP,AVTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KS - DO L=LF,LL + DO L=2,LA AVTMP=AVMX*HPI(L) ABTMP=ABMX*HPI(L) AV(L,K)=MIN(AV(L,K),AVTMP) AB(L,K)=MIN(AB(L,K),ABTMP) ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) c pmc AVUI(L,K)=2./(AV(L,K)+AV(L-1,K)) c pmc AVVI(L,K)=2./(AV(L,K)+AV(LS,K)) @@ -190,17 +164,14 @@ c pmc AVVI(L,K)=2./(AV(L,K)+AV(LS,K)) ENDDO ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA AQ(L,K)=0.205*(AV(L,K-1)+AV(L,K)) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA AQ(L,1)=0.205*AV(L,1) AQ(L,KC)=0.205*AV(L,KS) ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for index b354a9a85..30776de2f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for @@ -195,45 +195,31 @@ C ENDIF ! *** NOW APPLY MAXIMUM, IF REQURIED IF(ISAVBMX.GE.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,ABTMP,AVTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=2,LA AVTMP=AVMX*HPI(L) ABTMP=ABMX*HPI(L) AV(L,K)=MIN(AV(L,K),AVTMP) AB(L,K)=MIN(AB(L,K),ABTMP) ENDDO ENDDO -c - enddo ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) AVUI(L,K)=2./(AV(L,K)+AV(L-1,K)) AVVI(L,K)=2./(AV(L,K)+AV(LS,K)) ENDDO ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA AQ(L,K)=0.205*(AV(L,K-1)+AV(L,K)) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA AQ(L,1)=0.205*AV(L,1) AQ(L,KC)=0.205*AV(L,KS) ENDDO -c - enddo RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for index 347e68f63..0d7a4aba0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for @@ -1,4 +1,4 @@ - SUBROUTINE CALBUOY(LF,LL) + SUBROUTINE CALBUOY C C CHANGE RECORD C ** CALBUOY CALCULATES THE BUOYANCY USING MELLOR'S APPROXIMATION @@ -22,14 +22,14 @@ C & +6.536332E-9*TEM0*TEM0*TEM0*TEM0*TEM0 IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).EQ.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA B(L,K)=RHOO ENDDO ENDDO ENDIF IF(ISTRAN(1).GE.1.AND.ISTRAN(2).EQ.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA SAL(L,K)=MAX(SAL(L,K),0.) SSTMP=SAL(L,K) TEM0=ABS(TEMO) @@ -42,7 +42,7 @@ C ENDIF IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).GE.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA TTMP=TEM(L,K) B(L,K)=999.842594+6.793952E-2*TTMP-9.095290E-3*TTMP*TTMP & +1.001685E-4*TTMP*TTMP*TTMP-1.120083E-6*TTMP*TTMP* @@ -52,7 +52,7 @@ C ENDIF IF(ISTRAN(1).GE.1.AND.ISTRAN(2).GE.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA SAL(L,K)=MAX(SAL(L,K),0.) SSTMP=SAL(L,K) TTMP=TEM(L,K) @@ -71,7 +71,7 @@ C ** APPLY MELLOR'S PRESSURE CORRECTION C IF(ISPCOR.EQ.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA PRES=RHOO*G*HP(L)*(1.-ZZ(K))*1.E-6 CCON=1449.2+1.34*(SAL(L,K)-35.)+4.55*TEM(L,K) & -0.045*TEM(L,K)*TEM(L,K)+0.00821*PRES+15.E-9*PRES*PRES @@ -84,7 +84,7 @@ C C ** REPLACE DENSITY B(L,K) WITH BUOYANCY B(L,K) C DO K=1,KC - DO L=LF,LL + DO L=2,LA B(L,K)=(B(L,K)/RHOO)-1. ENDDO ENDDO @@ -93,7 +93,7 @@ C ** APPLY LOW SEDIMENT CONCENTRATION CORRECTION TO BUOYANCY C IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR1S(L,K)=0. TVAR1W(L,K)=0. ENDDO @@ -102,7 +102,7 @@ C IF(ISTRAN(6).GE.1)THEN DO NS=1,NSED DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SED(L,K,NS) TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SED(L,K,NS) ENDDO @@ -113,7 +113,7 @@ C DO NN=1,NSND NS=NN+NSED DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SND(L,K,NN) TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SND(L,K,NN) ENDDO @@ -122,7 +122,7 @@ C ENDIF IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA B(L,K)=B(L,K)*(1.-TVAR1S(L,K))+TVAR1W(L,K) ENDDO ENDDO @@ -134,7 +134,7 @@ C PURPOSES ONLY C 1000 CONTINUE DO K=1,KC - DO L=LF,LL + DO L=2,LA B(L,K)=0.00075*SAL(L,K) ENDDO ENDDO diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 3925fd204..5b52803e9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -146,49 +146,8 @@ C ** 3D ADVECTI0N TRANSPORT CALCULATION C C ** PRESPECIFY THE UPWIND CELLS FOR 3D ADVECTION C -c t00=rtc() - IF(IDRYTBP.EQ.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL - IF(UHDY2(L,K).GE.0.0)THEN - LUPU(L,K)=L-1 - ELSE - LUPU(L,K)=L - END IF - IF(VHDX2(L,K).GE.0.0)THEN - LUPV(L,K)=LSC(L) - ELSE - LUPV(L,K)=L - END IF - ENDDO - ENDDO - IF(KC.GT.1)THEN - DO K=1,KS - DO L=LF,LL - IF(W2(L,K).GE.0.)THEN - KUPW(L,K)=K - ELSE - KUPW(L,K)=K+1 ! *** DSLLC SINGLE LINE CHANGE, CHANGED K-1 TO K+1 - END IF - ENDDO - ENDDO - ENDIF -c - enddo - - ELSE -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN IF(UHDY2(L,K).GE.0.0)THEN LUPU(L,K)=L-1 @@ -205,7 +164,7 @@ c ENDDO IF(KC.GT.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN IF(W2(L,K).GE.0.)THEN KUPW(L,K)=K @@ -216,12 +175,6 @@ c ENDDO ENDDO ENDIF -c - enddo - ENDIF -c t00=rtc()-t00 -c write(6,*) '==>001 ',t00*1d3 - TTMP=SECNDS(0.0) C IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).LT.4) @@ -292,7 +245,6 @@ C ENDDO ENDIF CALL CPU_TIME(T2TMP) - TSADV=TSADV+T2TMP-TTMP C C ** 3D COSMIC ADVECTI0N TRANSPORT CALCULATION @@ -555,13 +507,10 @@ C ** VERTICAL DIFFUSION IMPLICIT HALF STEP CALCULATION C IF(KC.EQ.1) GOTO 1500 CALL CPU_TIME(T1TMP) -!$OMP PARALLEL DO PRIVATE(LF,LL,LF_LC,LL_LC,K, -!$OMP& RCDZKMK,RCDZKK,CCUBTMP,CCMBTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c RCDZKK=-DELTD2*CDZKK(1) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO L=LF,LL CCUBTMP=RCDZKK*HPI(L)*AB(L,1) CCMBTMP=1.-CCUBTMP @@ -604,7 +553,10 @@ c ENDDO ENDDO ENDIF -c + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO K=2,KS RCDZKMK=-DELTD2*CDZKMK(K) RCDZKK=-DELTD2*CDZKK(K) @@ -652,10 +604,12 @@ c ENDDO ENDIF ENDDO -C + ENDDO K=KC RCDZKMK=-DELTD2*CDZKMK(K) -c + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO L=LF,LL CCLBTMP(L)=RCDZKMK*HPI(L)*AB(L,K-1) CCMBTMP=1.-CCLBTMP(L) @@ -697,7 +651,10 @@ c ENDDO ENDDO ENDIF -c + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO K=KC-1,1,-1 IF(ISTRAN(1).GE.1)THEN DO L=LF,LL @@ -736,52 +693,47 @@ c ENDDO ENDIF ENDDO - LF_LC=jse_LC(1,ithds) - LL_LC=jse_LC(2,ithds) -c + ENDDO DO K=1,KB - DO L=LF_LC,LL_LC + DO L=1,LC SEDBT(L,K)=0. SNDBT(L,K)=0. ENDDO ENDDO - DO NS=1,NSED + DO K=1,KC + DO L=1,LC + SEDT(L,K)=0. + SNDT(L,K)=0. + ENDDO + ENDDO DO K=1,KB - DO L=LF_LC,LL_LC + DO NS=1,NSED + DO L=1,LC SEDBT(L,K)=SEDBT(L,K)+SEDB(L,K,NS) ENDDO ENDDO ENDDO DO NS=1,NSND DO K=1,KB - DO L=LF_LC,LL_LC + DO L=1,LC SNDBT(L,K)=SNDBT(L,K)+SNDB(L,K,NS) ENDDO ENDDO ENDDO -C - DO K=1,KC - DO L=LF_LC,LL_LC - SEDT(L,K)=0. - SNDT(L,K)=0. - ENDDO - ENDDO DO NS=1,NSED DO K=1,KC - DO L=LF_LC,LL_LC + DO L=1,LC SEDT(L,K)=SEDT(L,K)+SED(L,K,NS) ENDDO ENDDO ENDDO DO NS=1,NSND DO K=1,KC - DO L=LF_LC,LL_LC + DO L=1,LC SNDT(L,K)=SNDT(L,K)+SND(L,K,NS) ENDDO ENDDO ENDDO -c - enddo CALL CPU_TIME(T2TMP) TVDIF=TVDIF+T2TMP-T1TMP 1500 CONTINUE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for index 842868f60..9563da03b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for @@ -89,32 +89,19 @@ C ** INITIALIZE EXTERNAL CORIOLIS-CURVATURE AND ADVECTIVE FLUX TERMS C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC FCAXE(L)=0. FCAYE(L)=0. FXE(L)=0. FYE(L)=0. ENDDO -c - enddo C C C----------------------------------------------------------------------C C IF(IS2LMC.NE.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,UHC,UHB,VHC,VHB) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -141,20 +128,10 @@ C ENDIF ENDDO ENDDO - enddo C ELSE !IF(IS2LMC.EQ.1)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,UHC1,UHB1,VHC1,VHB1,UHC2,UHB2,VHC2,VHB2, -!$OMP& UHB1MX,UHB1MN,VHC1MX,VHC1MN,UHC1MX,UHC1MN,VHB1MX,VHB1MN, -!$OMP& UHB2MX,UHB2MN,VHC2MX,VHC2MN,UHC2MX,UHC2MN,VHB2MX,VHB2MN, -!$OMP& BOTT) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -264,7 +241,6 @@ C FVHJ(L,2)=0. ENDIF ENDDO - enddo ENDIF C C ADD RETURN FLOW MOMENTUM FLUX @@ -324,14 +300,8 @@ C----------------------------------------------------------------------C C C *** COMPUTE VERTICAL ACCELERATIONS C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS,WU,WV) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LS=LSC(L) WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) @@ -355,16 +325,13 @@ C ** BLOCK MOMENTUM FLUX ON LAND SIDE OF TRIANGULAR CELLS C IF(ITRICELL.GT.0)THEN DO K=1,KC - DO L=LF,LL + DO L=1,LA FUHU(L,K)=STCUV(L)*FUHU(L,K) FVHV(L,K)=STCUV(L)*FVHV(L,K) ENDDO ENDDO ENDIF -c - enddo C - C**********************************************************************C C C ** CALCULATE CORIOLIS AND CURVATURE ACCELERATION COEFFICIENTS @@ -377,14 +344,8 @@ C IF(ISDCCA.EQ.0)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) -!$OMP& REDUCTION(+:CACSUM) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) CAC(L,K)=( FCORC(L)*DXYP(L) @@ -396,9 +357,6 @@ c CACSUM=CACSUM+CAC(L,K) ENDDO ENDDO -c - enddo - C ELSE C @@ -427,7 +385,6 @@ C ENDDO CLOSE(1) ENDIF - ENDIF ! *** ENSURE FCAY & FCAX ARE RESET @@ -439,7 +396,6 @@ C FCAY(L,K)=0. ENDDO ENDDO - ENDIF ENDIF @@ -457,14 +413,8 @@ C ** STANDARD CALCULATION C IF(IS2LMC.EQ.0.AND.CACSUM.GT.1.E-7)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,LNW,LSE) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -480,8 +430,6 @@ c ENDIF ENDDO ENDDO - enddo - C C----------------------------------------------------------------------C C @@ -527,7 +475,6 @@ C ENDIF ENDDO ENDIF - C C----------------------------------------------------------------------C C @@ -576,18 +523,11 @@ C ENDIF ENDDO ENDIF - C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -603,9 +543,6 @@ c ENDIF ENDDO ENDDO -c - enddo - ! *** TREAT BC'S NEAR EDGES DO LL=1,NBCS @@ -628,7 +565,6 @@ c FY(L,K)=SAAY(L)*FY(L,K) ENDDO ENDDO - C C----------------------------------------------------------------------C C @@ -680,7 +616,6 @@ C CLOSE(1) ENDIF ENDIF - C C**********************************************************************C C @@ -867,16 +802,10 @@ C C ** CALCULATE EXTERNAL ACCELERATIONS C C----------------------------------------------------------------------C - C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISDRY.GT.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) @@ -887,7 +816,7 @@ c ENDDO ELSE DO K=1,KC - DO L=LF,LL + DO L=2,LA FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) FXE(L)=FXE(L)+FX(L,K)*DZC(K) @@ -904,7 +833,7 @@ C----------------------------------------------------------------------C C IF(KC.GT.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN FX(L,K)=FX(L,K)+SAAX(L)*(FWU(L,K)-FWU(L,K-1))*DZIC(K) FY(L,K)=FY(L,K)+SAAY(L)*(FWV(L,K)-FWV(L,K-1))*DZIC(K) @@ -922,7 +851,7 @@ C IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN C DO K=1,KC - DO L=LF,LL + DO L=2,LA QMCSOURX(L,K)=0. QMCSOURY(L,K)=0. QMCSINKX(L,K)=0. @@ -930,9 +859,6 @@ C ENDDO ENDDO ENDIF -c - enddo -C IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN C @@ -1098,13 +1024,8 @@ C IF(IINTPG.EQ.0)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) FBBX(L,K)=SBX(L)*GP*HU(L)* & ( HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) @@ -1118,8 +1039,6 @@ c & (BELV(L)-BELV(LS)+Z(K)*(HP(L)-HP(LS))) ) ENDDO ENDDO -c - enddo C ENDIF C @@ -1257,24 +1176,14 @@ C ** CALCULATE EXPLICIT INTERNAL U AND V SHEAR EQUATION TERMS C C----------------------------------------------------------------------C C - IF(KC.GT.1)THEN - L=1 - DU(L,KC)=0.0 - DV(L,KC)=0.0 - L=LC + DO L=1,LC DU(L,KC)=0.0 DV(L,KC)=0.0 - ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL,RCDZF) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - IF(KC.GT.1)THEN + ENDDO DO K=1,KS RCDZF=CDZF(K) - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN !DXYIU(L)=1./(DXU(L)*DYU(L)) DU(L,K)=RCDZF*( HU(L)*(U(L,K+1)-U(L,K))*DELTI @@ -1295,14 +1204,11 @@ C C IF(ISTL.EQ.2)THEN C IF(NWSER.GT.0)THEN - DO L=LF,LL + DO L=2,LA DU(L,KS)=DU(L,KS)-CDZU(KS)*TSX(L) DV(L,KS)=DV(L,KS)-CDZU(KS)*TSY(L) ENDDO ENDIF -c - enddo - C C ENDIF C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for index a0dfffa8b..fb5b16d32 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for @@ -26,41 +26,33 @@ C ! *** SELECTIVE ZEROING IF(KC.GT.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN - DO L=LF,LL + DO L=1,LC FQC(L,1)=0. ENDDO ENDIF ! *** ZERO EVAP/RAINFALL IF(MVAR.EQ.2)THEN - DO L=LF,LL + DO L=1,LC FQC(L,KC)=0. ENDDO IF(ISADAC(MVAR).GE.2)THEN - DO L=LF,LL + DO L=1,LC FQCPAD(L,KC)=0. ENDDO ENDIF IF(ISADAC(MVAR).GT.0)THEN - DO L=LF,LL + DO L=1,LC QSUMPAD(L,KC)=0. ENDDO ENDIF ENDIF -c - enddo ! *** ZERO ALL DEFINED BC'S - DO K=1,KC DO NS=1,NBCS L=LBCS(NS) + DO K=1,KC FQC(L,K)=0. FQCPAD(L,K)=0 QSUMPAD(L,K)=0. @@ -130,30 +122,23 @@ C ! *** 2TL STANDARD IF(ISTL_.EQ.2.AND.IS2TL_.EQ.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN - DO L=LF,LL + DO L=1,LC CONQ(L,1)=0.5*(3.*CON(L,1)-CON1(L,1)) ENDDO ENDIF ! *** ZERO EVAP/RAINFALL IF(MVAR.EQ.2)THEN - DO L=LF,LL + DO L=1,LC CONQ(L,KC)=0.5*(3.*CON(L,KC)-CON1(L,KC)) ENDDO ENDIF -c - enddo ! *** INITIALIZE ALL DEFINED BC'S - DO K=1,KC DO NS=1,NBCS L=LBCS(NS) + DO K=1,KC CONQ(L,K)=0.5*(3.*CON(L,K)-CON1(L,K)) ENDDO ENDDO @@ -354,20 +339,15 @@ C & -(QWR(NWR)+QWRSERT(NQSTMP)) ENDIF ! *** GROUNDWATER, EVAP, RAINFALL (2TL) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISGWIE.NE.0)THEN - DO L=LF,LL + DO L=2,LA FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) ENDDO ENDIF ! *** ZONED SEEPAGE (2TL) IF(ISGWIT.EQ.3)THEN - DO L=LF,LL + DO L=2,LA IF(H1P(L).GT.HDRY)THEN FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) ENDIF @@ -378,12 +358,12 @@ c IF(M.EQ.2)THEN IF(ISTOPT(2).EQ.0.OR.ISTOPT(2).EQ.3)THEN - DO L=LF,LL + DO L=2,LA FQC(L,KC)=FQC(L,KC)+RAINT(L)*TEMO*DXYP(L) ENDDO ENDIF IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.2.OR.ISTOPT(2).EQ.4)THEN - DO L=LF,LL + DO L=2,LA FQC(L,KC)=FQC(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) FQCPAD(L,KC)=FQCPAD(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) QSUMPAD(L,KC)=QSUMPAD(L,KC)+RAINT(L)*DXYP(L) @@ -392,13 +372,11 @@ c ENDIF IF(M.EQ.2)THEN IF(ISTOPT(2).EQ.0)THEN - DO L=LF,LL + DO L=2,LA FQC(L,KC)=FQC(L,KC)-EVAPSW(L)*CONQ(L,KC) ENDDO ENDIF ENDIF -c - enddo ENDIF C C *********************************************************************C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for index 8bcfb943a..27897a708 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for @@ -71,25 +71,19 @@ C IF(AHD.GT.0.0)THEN SLIPCO=0.5/SQRT(AHD) ENDIF -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,DY2DZBR,CSDRAG,SLIPFAC, -!$OMP& LW,DX2DZBR) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -! DO K=1,KC - DO L=LF,LL + DO L=2,LA LN=LNC(L) ! *** DXU1 = dU/dX, UNITS: 1/S DXU1(L,K)=SUB(L+1)*(U(L+1,K)-U(L,K))/DXP(L) ! *** DYV1 = dV/dY, UNITS: 1/S DYV1(L,K)=SVB(LN )*(V(LN,K)-V(L,K))/DYP(L) ENDDO + ENDDO C ! *** DYU1 = dU/dY - DO L=LF,LL + DO K=1,KC + DO L=2,LA LS=LSC(L) IF(ICORDYU(L).EQ.1)THEN DYU1(L,K)=2.*SVB(L)*(U(L,K)-U(LS,K))/(DYU(L)+DYU(LS)) @@ -112,9 +106,11 @@ C ENDIF ENDIF ENDDO + ENDDO C ! *** DXV1 = dV/dX - DO L=LF,LL + DO K=1,KC + DO L=2,LA LW=L-1 IF(ICORDXV(L).EQ.1)THEN DXV1(L,K)=2.*SUB(L)*(V(L,K)-V(LW,K))/(DXV(L)+DXV(LW)) @@ -137,15 +133,14 @@ C ENDIF ENDIF ENDDO + ENDDO C ! *** SXY = dU/dY + dV/dX - DO L=LF,LL + DO K=1,KC + DO L=2,LA SXY(L,K)=DYU1(L,K)+DXV1(L,K) ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C C DO K=1,KC C DO L=2,LA @@ -163,39 +158,21 @@ C ENDDO C IF(AHD.GT.0.0)THEN ! *** CALCULATE SMAGORINSKY HORIZONTAL VISCOSITY -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& TMPVAL,DSQR) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KC - DO L=LF,LL + DO L=2,LA TMPVAL=AHD*DXP(L)*DYP(L) DSQR=DXU1(L,K)*DXU1(L,K)+DYV1(L,K)*DYV1(L,K)+ & SXY(L,K)*SXY(L,K)/4 AH(L,K)=AHO+TMPVAL*SQRT(DSQR) ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO ELSEIF(N.LT.10)THEN ! *** ONLY NEED TO ASSIGN INITIALLY -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& TMPVAL,DSQR) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KC - DO L=LF,LL + DO L=2,LA AH(L,K)=AHO ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO ENDIF C C *** DSLLC BEGIN BLOCK @@ -248,14 +225,8 @@ C C C ** CALCULATE DIFFUSIVE MOMENTUM FLUXES C -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) DO K=1,KC - DO L=LF,LL + DO L=2,LA LS=LSC(L) LN=LNC(L) ! SANG'S CORRECTION @@ -277,20 +248,10 @@ C ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C ! *** TREAT THE NORTH & WEST WALL SLIPPAGE IF(ISHDMF.EQ.2)THEN -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,DY2DZBR,CSDRAG,SLIPFAC, -!$OMP& SXYLN,DX2DZBR,SXYEE) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) - DO L=LF,LL + DO L=2,LA LN=LNC(L) IF(SVBO(LN).LT.0.5)THEN DO K=1,KC @@ -311,9 +272,6 @@ C ENDDO ENDIF ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO ENDIF ! *** ZERO BOUNDARY CELL MOMENTUM DIFFUSION diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index d59a42aef..8b4ec6bb6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -260,22 +260,14 @@ CPMC DELT=DT2 IF(ISTOPT(2).EQ.1)THEN ! *** FULL HEAT BALANCE WITH ATMOSPHERIC LINKAGE -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& SVPW,CLDFAC,RAN,FW,RE,RC, -!$OMP& RB,TFAST,TFAST1,TSLOW,TSLOW1, -!$OMP& RSN,C2,UBED,VBED,USPD,TMPVAL, -!$OMP& C1) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) - ! NET HEAT FLUX = RSN+RAN-RB-RE-RC (WATT/M2) - DO L=LF,LL - ! *** SET UP MIN DEPTH + ! *** SET UP MIN DEPTH + DO L=2,LA HDEP(L)=MAX(HP(L),0.) + ENDDO - + ! NET HEAT FLUX = RSN+RAN-RB-RE-RC (WATT/M2) + DO L=2,LA SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ & (1.+0.00412*TEM(L,KC)))) @@ -315,14 +307,14 @@ CPMC DELT=DT2 TSLOW=SWRATNS*(Z(KC)-1.) TSLOW1=SWRATNS*(Z(KC-1)-1.) IF(FSWRATF.LT.1.)THEN - DO L=LF,LL + DO L=2,LA RSN=SOLSWRT(L)* & ( FSWRATF*(EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) & +(1.-FSWRATF)*(EXP(TSLOW*HDEP(L))-EXP(TSLOW1*HDEP(L)))) NETRAD(L,KC)=NETRAD(L,KC)+RSN ENDDO ELSE - DO L=LF,LL + DO L=2,LA RSN=SOLSWRT(L)*(1.-EXP(TFAST1*HDEP(L))) NETRAD(L,KC)=NETRAD(L,KC)+RSN ENDDO @@ -337,14 +329,14 @@ CPMC DELT=DT2 IF(FSWRATF.LT.1.)THEN TSLOW=SWRATNS*(Z(K)-1.) TSLOW1=SWRATNS*(Z(K-1)-1.) - DO L=LF,LL + DO L=2,LA RSN=SOLSWRT(L)* & ( FSWRATF*(EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) & +(1.-FSWRATF)*(EXP(TSLOW*HDEP(L))-EXP(TSLOW1*HDEP(L)))) NETRAD(L,K)=RSN ENDDO ELSE - DO L=LF,LL + DO L=2,LA RSN=SOLSWRT(L)* & (EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) NETRAD(L,K)=RSN @@ -357,7 +349,7 @@ CPMC DELT=DT2 TFAST=SWRATNF*(Z(0)-1.) IF(FSWRATF.LT.1.)THEN TSLOW=SWRATNS*(Z(0)-1.) - DO L=LF,LL + DO L=2,LA UBED=0.5*( U(L,1)+U(L+1,1) ) VBED=0.5*( V(L,1)+V(LNC(L),1) ) USPD=SQRT( UBED*UBED+VBED*VBED ) @@ -372,7 +364,7 @@ CPMC DELT=DT2 ENDIF ENDDO ELSE - DO L=LF,LL + DO L=2,LA UBED=0.5*( U(L,1)+U(L+1,1) ) VBED=0.5*( V(L,1)+V(LNC(L),1) ) USPD=SQRT( UBED*UBED+VBED*VBED ) @@ -393,48 +385,47 @@ CPMC DELT=DT2 ! *** CP = 4179.0 Specific Heat (J / kg / degC) ! *** 0.2393E-6 = 1/RHO/CP C1=DELT*DZIC(K)*0.2393E-6 - DO L=LF,LL + DO L=2,LA TEM(L,K)=TEM(L,K)+HPI(L)*C1*NETRAD(L,K) ENDDO ENDDO IF(ISDRY.GT.0.AND.ISTOPT(2).EQ.1)THEN - DO L=LF,LL + DO L=2,LA IF(IMASKDRY(L).EQ.1.) TEMB(L)=TATMT(L) ENDDO ENDIF ELSE ! IF(IASWRAD.EQ.1)THEN - C1=DELT*DZIC(KC)*0.2393E-6 - DO L=LF,LL - ! *** ADSORB SW SOLR RAD TO TO SURFACE LAYER + ! *** ADSORB SW SOLR RAD TO TO SURFACE LAYER + DO L=2,LA NETRAD(L,KC)=NETRAD(L,KC)+SOLSWRT(L) - ! *** NOW FINALIZE THE TEMPERATURE + ENDDO + + ! *** NOW FINALIZE THE TEMPERATURE + C1=DELT*DZIC(KC)*0.2393E-6 + DO L=2,LA TEM(L,KC)=TEM(L,KC)+HPI(L)*C1*NETRAD(L,KC) ENDDO ENDIF -! - enddo -!$OMP END PARALLEL DO + ELSEIF(ISTOPT(2).EQ.2)THEN ! *** IMPLEMENT EXTERNALLY SPECIFIED EQUILIBRIUM TEMPERATURE FORMULATION TMPKC=DELT/DZC(KC) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO L=LF,LL ! [ GEOSR 2010.5.13 -c TEM(L,KC)=TEM(L,KC)-TMPKC*CLOUDT(L)*HPI(L)*(TEM(L,KC) -c & -TATMT(L)) - TEM(L,KC)=TEM(L,KC)-TMPKC*SOLSWRT(L)*HPI(L)*(TEM(L,KC) + TEM(L,KC)=TEM(L,KC)-TMPKC*CLOUDT(L)*HPI(L)*(TEM(L,KC) & -TATMT(L)) +c TEM(L,KC)=TEM(L,KC)-TMPKC*SOLSWRT(L)*HPI(L)*(TEM(L,KC) +c & -TATMT(L)) ! GEOSR 2010.5.13 ] ENDDO ENDDO -!$OMP END PARALLEL DO + ELSEIF(ISTOPT(2).EQ.3)THEN ! *** IMPLEMENT CONSTANT COEFFICIENT EQUILIBRIUM TEMPERATURE FORMULATION DTHEQT=DELT*HEQT*FLOAT(KC) @@ -600,13 +591,8 @@ c & -TATMT(L)) ! *** APPLY DRY CELL CORRECTIONS IF(ISDRY.GT.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(.NOT.LMASKDRY(L))THEN TEM(L,K)=TATMT(L) ! *** BEGIN PMC @@ -624,8 +610,6 @@ c ENDIF ENDDO ENDDO -c - enddo ENDIF 600 FORMAT(4I5,2E12.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for index a8c549e1d..5e96f5a42 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for @@ -18,12 +18,14 @@ C END IF S2TL=0.0 BSMALL=1.E-12 -! -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) - DO L=LF,LL + DO K=1,KS + DO L=2,LA + QQ2(L,K)=QQ(L,K)+QQ(L,K) + QQL2(L,K)=QQL(L,K)+QQL(L,K) + ENDDO + ENDDO +C + DO L=1,LC UUU(L,KC)=0. VVV(L,KC)=0. FUHU(L,KC)=0. @@ -31,22 +33,6 @@ C FVHU(L,KC)=0. FUHV(L,KC)=0. ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO -C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& WB,LS,UHUW,VHVW) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -! - DO K=1,KS - DO L=LF,LL - QQ2(L,K)=QQ(L,K)+QQ(L,K) - QQL2(L,K)=QQL(L,K)+QQL(L,K) - ENDDO - ENDDO C C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH TRANSPORT C ** AVERAGED BETWEEN (N) AND (N+1) AND TRANSPORTED FIELD AT (N) OR @@ -56,7 +42,7 @@ C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV C IF(IDRYTBP.EQ.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) & +MIN(WB,0.)*QQ(L,K) @@ -66,7 +52,7 @@ C ENDDO ELSE DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) @@ -83,7 +69,7 @@ C C IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) @@ -99,7 +85,7 @@ C ENDDO ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LS=LSC(L) UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) @@ -121,9 +107,6 @@ C ENDDO ENDDO ENDIF -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C C ** CALCULATE PRODUCTION, LOAD BOUNDARY CONDITIONS AND SOLVE C ** TRANSPORT EQUATIONS @@ -161,16 +144,10 @@ C ENDIF ENDDO ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,PQQB,PQQU,PQQ,TMPVAL,WVFACT,PQQV,PQQW,FFTMP,PQQL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -! IF(ISWAVE.LE.1.OR.ISWAVE.EQ.3)THEN IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) UUU(L,K)=QQ(L,K)*H1P(L) & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) @@ -178,8 +155,17 @@ C VVV(L,K)=QQL(L,K)*H1P(L)*H1P(L) & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA UUU(L,K)=MAX(UUU(L,K),0.) VVV(L,K)=MAX(VVV(L,K),0.) + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA + LN=LNC(L) LS=LSC(L) PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1)- @@ -189,11 +175,11 @@ C UUU(L,K)=UUU(L,K)+2.*PQQ PQQL=DELT*H1P(L)*(CTE3*PQQB+CTE1*PQQU) VVV(L,K)=VVV(L,K)+DML(L,K)*PQQL - ENDDO !DO L=LF,LL - ENDDO ! DO K=1,KS + ENDDO + ENDDO ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) UUU(L,K)=QQ(L,K)*H1P(L) @@ -213,7 +199,7 @@ C ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -241,12 +227,12 @@ C WVFACT=1.0 ENDIF DO K=1,KS - DO L=LF,LL + DO L=2,LA TVAR1W(L,K)=WVDTKEM(K)*WVDISP(L,K)+WVDTKEP(K)*WVDISP(L,K+1) ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -269,22 +255,12 @@ C ENDDO ENDDO ENDIF -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C C *** DSLLC END BLOCK C -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL, -!$OMP& QQHDH,DMLTMP,DELB,DMLMAX) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) IF(KC.LE.2)THEN IF(IDRYTBP.EQ.0)THEN - DO L=LF,LL + DO L=2,LA CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) CMQTMP=1.-CLQTMP-CUQTMP @@ -301,7 +277,7 @@ C VVV(L,1)=VVV(L,1)*EQL ENDDO ELSE - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) @@ -323,7 +299,7 @@ C ENDIF IF(KC.GT.2)THEN IF(IDRYTBP.EQ.0)THEN - DO L=LF,LL + DO L=2,LA CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) CMQTMP=1.-CLQTMP-CUQTMP @@ -341,7 +317,7 @@ C UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) CMQTMP=1.-CLQTMP-CUQTMP @@ -358,13 +334,13 @@ C ENDDO ENDDO DO K=KS-1,1,-1 - DO L=LF,LL + DO L=2,LA UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) ENDDO ENDDO ELSE - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) @@ -384,7 +360,7 @@ C ENDIF ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) @@ -403,7 +379,7 @@ C ENDDO ENDDO DO K=KS-1,1,-1 - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) @@ -414,7 +390,7 @@ C ENDIF IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA QQ1(L,K)=QQ(L,K) QQHDH=UUU(L,K)*HPI(L) QQ(L,K)=MAX(QQHDH,QQMIN) @@ -425,7 +401,7 @@ C ** ORIGINAL FORM MODIFED FOR DIMENSIONAL LENGHT SCALE TRANSPORT C IF(ISTOPT(0).EQ.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L)*HPI(L) QQL(L,K)=MAX(QQHDH,QQLMIN) @@ -446,7 +422,7 @@ C ** BUCHARD'S MODIFED CLOSURE FOR DIMENSIONAL LENGHT SCALE TRANSPORT C IF(ISTOPT(0).EQ.2)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L)*HPI(L) QQL(L,K)=MAX(QQHDH,QQLMIN) @@ -457,7 +433,7 @@ C ENDIF ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQ1(L,K)=QQ(L,K) QQHDH=UUU(L,K)*HPI(L) @@ -470,7 +446,7 @@ C ** ORIGINAL FORM MODIFED FOR DIMENSIONAL LENGHT SCALE TRANSPORT C IF(ISTOPT(0).EQ.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L)*HPI(L) @@ -493,7 +469,7 @@ C ** BUCHARD'S MODIFED CLOSURE FOR DIMENSIONAL LENGHT SCALE TRANSPORT C IF(ISTOPT(0).EQ.2)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L)*HPI(L) @@ -505,9 +481,6 @@ C ENDDO ENDIF ENDIF -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C C QQMXSV=-1.E+12 C QQMNSV=1.E+12 @@ -549,19 +522,11 @@ C ENDDO ENDDO C *** DSLLC BEGIN BLOCK -! -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) DO K=1,KS - DO L=LF,LL + DO L=1,LC QQSQR(L,K)=SQRT(QQ(L,K)) ! *** DSLLC ENDDO ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO C *** DSLLC END BLOCK 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', & ' PROD+ADV 1./DIAGON') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for index 506e9a4de..a48c845fe 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for @@ -22,12 +22,14 @@ C S2TL=0.0 BSMALL=1.E-12 C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO K=1,KS + DO L=2,LA + QQ2(L,K)=QQ(L,K)+QQ(L,K) + QQL2(L,K)=QQL(L,K)+QQL(L,K) + ENDDO + ENDDO +C + DO L=1,LC UUU(L,KC)=0. VVV(L,KC)=0. FUHU(L,KC)=0. @@ -35,21 +37,6 @@ c FVHU(L,KC)=0. FUHV(L,KC)=0. ENDDO -c - enddo -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& WB,LS,UHUW,VHVW) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c -C - DO K=1,KS - DO L=LF,LL - QQ2(L,K)=QQ(L,K)+QQ(L,K) - QQL2(L,K)=QQL(L,K)+QQL(L,K) - ENDDO - ENDDO C C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH TRANSPORT C ** AVERAGED BETWEEN (N) AND (N+1) AND TRANSPORTED FIELD AT (N) OR @@ -59,7 +46,7 @@ C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV C IF(IDRYTBP.EQ.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) & +MIN(WB,0.)*QQ(L,K) @@ -69,7 +56,7 @@ C ENDDO ELSE DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) @@ -91,7 +78,7 @@ C WB=0.25*DXYP(L)*(W2(L,K-1)+W2(L,K)) C IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) @@ -107,7 +94,7 @@ C ENDDO ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LS=LSC(L) UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) @@ -129,8 +116,6 @@ C ENDDO ENDDO ENDIF -c - enddo C C ELSE C UHUW=0.25*(UHDY2(L,K)+UHDY2(L,K+1)) @@ -174,16 +159,10 @@ C ENDIF ENDDO ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,PQQB,PQQU,PQQ,TMPVAL,WVFACT,PQQV,PQQW,FFTMP,PQQL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISWAVE.LE.1.OR.ISWAVE.EQ.3)THEN IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) UUU(L,K)=QQ(L,K)*H1P(L) & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) @@ -191,8 +170,17 @@ c VVV(L,K)=QQL(L,K)*H1P(L) & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA UUU(L,K)=MAX(UUU(L,K),0.) VVV(L,K)=MAX(VVV(L,K),0.) + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA + LN=LNC(L) LS=LSC(L) PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1)- @@ -205,7 +193,7 @@ c ENDDO ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) UUU(L,K)=QQ(L,K)*H1P(L) @@ -225,7 +213,7 @@ c ENDDO C DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LN=LNC(L) LS=LSC(L) @@ -255,12 +243,12 @@ C WVFACT=1.0 ENDIF DO K=1,KS - DO L=LF,LL + DO L=2,LA TVAR1W(L,K)=WVDTKEM(K)*WVDISP(L,K)+WVDTKEP(K)*WVDISP(L,K+1) ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) @@ -281,8 +269,6 @@ C ENDDO ENDDO ENDIF -c - enddo C C *** DSLLC END BLOCK C @@ -325,16 +311,9 @@ C ENDDO ENDIF ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL, -!$OMP& QQHDH,DMLTMP,DELB,DMLMAX) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(KC.GT.2)THEN IF(IDRYTBP.EQ.0)THEN - DO L=LF,LL + DO L=2,LA CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) CMQTMP=1.-CLQTMP-CUQTMP @@ -352,7 +331,7 @@ c UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) CMQTMP=1.-CLQTMP-CUQTMP @@ -372,13 +351,13 @@ C ENDDO ENDDO DO K=KS-1,1,-1 - DO L=LF,LL + DO L=2,LA UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) ENDDO ENDDO ELSE - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) @@ -398,7 +377,7 @@ C ENDIF ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) @@ -420,7 +399,7 @@ C ENDDO ENDDO DO K=KS-1,1,-1 - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) @@ -431,14 +410,14 @@ C ENDIF IF(IDRYTBP.EQ.0)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA QQ1(L,K)=QQ(L,K) QQHDH=UUU(L,K)*HPI(L) QQ(L,K)=MAX(QQHDH,QQMIN) -c ENDDO -c ENDDO -c DO K=1,KS -c DO L=LF,LL + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L) QQL(L,K)=MAX(QQHDH,QQLMIN) @@ -455,7 +434,7 @@ c DO L=LF,LL ENDDO ELSE DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQ1(L,K)=QQ(L,K) QQHDH=UUU(L,K)*HPI(L) @@ -464,7 +443,7 @@ c DO L=LF,LL ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN QQL1(L,K)=QQL(L,K) QQHDH=VVV(L,K)*HPI(L) @@ -482,8 +461,6 @@ c DO L=LF,LL ENDDO ENDDO ENDIF -c - enddo C C QQMXSV=-1.E+12 C QQMNSV=1.E+12 @@ -498,18 +475,24 @@ C QQL(L,K)=QQL(LN,K) DML(L,K)=DML(LN,K) ENDDO + ENDDO + DO K=1,KS DO LL=1,NCBW L=LCBW(LL) QQ(L,K)=QQ(L+1,K) QQL(L,K)=QQL(L+1,K) DML(L,K)=DML(L+1,K) ENDDO + ENDDO + DO K=1,KS DO LL=1,NCBE L=LCBE(LL) QQ(L,K)=QQ(L-1,K) QQL(L,K)=QQL(L-1,K) DML(L,K)=DML(L-1,K) ENDDO + ENDDO + DO K=1,KS DO LL=1,NCBN L=LCBN(LL) LS=LSC(L) @@ -519,18 +502,11 @@ C ENDDO ENDDO C *** DSLLC BEGIN BLOCK -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=1,LC QQSQR(L,K)=SQRT(QQ(L,K)) ! *** DSLLC ENDDO ENDDO -c - enddo C *** DSLLC END BLOCK 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', & ' PROD+ADV 1./DIAGON') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for index b20b2c5a2..584d08d7f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for @@ -5,7 +5,7 @@ C ** SUBROUTINE CALQVS UPDATES TIME VARIABLE VOLUME SOURCES C USE GLOBAL - REAL T1TMP, SECNDS + REAL T1TMP,T2TMP INTEGER*4 NS ! *** PMC @@ -37,79 +37,51 @@ C GWCSERT(0,NC)=0. ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA QGW(L)=0.0 END DO IF(ISTRAN(5).GT.0)THEN DO NC=1,NCTMP - DO L=LF,LL + DO L=2,LA CONGW(L,NC)=0.0 END DO END DO ENDIF -c - enddo ENDIF C C ** INITIALIZE TOTAL FLOW SERIES C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC QSUM1E(L)=QSUME(L) ! *** DSLLC SINGLE LINE QSUME(L)=0. ENDDO -c - enddo ! *** SELECTIVE ZEROING IF(KC.GT.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN - DO L=LF,LL + DO L=1,LC QSUM(L,1)=0. ENDDO ENDIF ! *** ZERO EVAP/RAINFALL - DO L=LF,LL + DO L=1,LC QSUM(L,KC)=0. ENDDO -c - enddo ! *** ZERO ALL DEFINED BC'S - DO K=1,KC DO NS=1,NBCS L=LBCS(NS) + DO K=1,KC QSUM(L,K)=0. ENDDO ENDDO ELSE ! *** SINGLE LAYER -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC QSUM(L,1)=0. ENDDO -c - enddo ENDIF C C ** VOLUME SOURCE/SINK INTERPOLATION @@ -204,40 +176,26 @@ C GWCSERT(NC,NS)=WTM1*GWCSER(M1,NC,NS)+WTM2*GWCSER(M2,NC,NS) END DO ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA QGW(L)=GWFAC(L)*GWSERT(NGWSL(L)) END DO IF(ISTRAN(5).GT.0)THEN DO NC=1,NCTMP - DO L=LF,LL + DO L=2,LA CONGW(L,NC)=GWCSERT(NC,NGWSL(L)) END DO END DO ENDIF -c - enddo ENDIF ! *** CONSTANT GW LOSSES IF(ISGWIT.EQ.3)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IF(H1P(L).GE.HDRY)THEN !VOLOUTO=VOLOUTO+RIFTR(L)*DTIM QSUM(L,1)=QSUM(L,1)-RIFTR(L) ENDIF ENDDO -c - enddo !IF((H1P(343).GE.HDRY.or.HP(343).GE.HDRY).and.TIMEDAY.GT.6.5)THEN ! VOLOUTE=VOLOUTE+RIFTR(L)*DTIM ! WRITE(99,*)N,TIMEDAY,RIFTR(L),H1P(L),HP(L),VOLOUTE @@ -246,7 +204,7 @@ c C C ** CONTROL STRUCTURES AND TIDAL INLETS C - T1TMP=SECNDS(0.0) + CALL CPU_TIME(T1TMP) DO NCTL=1,NQCTL IF(NQCTYP(NCTL).LE.1)THEN NCTLT=NQCTLQ(NCTL) @@ -430,7 +388,8 @@ C { GEOSR 2010.5.6 GATE NORMAL FORMULA ENDIF ENDIF C } GEOSR 2010.5.6 GATE NORMAL FORMULA - TQCTL=TQCTL+SECNDS(T1TMP) + CALL CPU_TIME(T2TMP) + TQCTL=TQCTL+T2TMP-T1TMP C C ** FLOW WITHDRAWAL AND RETURN C @@ -564,14 +523,9 @@ C C C ** GROUND WATER INTERACTION, EVAPORATION AND RAINFALL C -!$OMP PARALLEL DO PRIVATE(LF,LL,SVPW) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISGWIE.EQ.0)THEN IF(EVAPCVT.LT.0.)THEN - DO L=LF,LL + DO L=2,LA SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ & (1.+0.00412*TEM(L,KC)))) EVAPT(L)=CLEVAP(L)*0.7464E-3*WINDST(L)*(SVPW-VPA(L))/PATMT(L) @@ -579,33 +533,24 @@ c QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*(RAINT(L)-EVAPT(L)) ENDDO ELSE - DO L=LF,LL + DO L=2,LA IF(HP(L).LT.HWET) EVAPT(L)=0. QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*(RAINT(L)-EVAPT(L)) ENDDO ENDIF ELSE - DO L=LF,LL + DO L=2,LA QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*RAINT(L) ENDDO ENDIF -c - enddo C C ** DETERMINE NET EXTERNAL VOLUME SOURCE/SINK C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=1,LC QSUME(L)=QSUME(L)+QSUM(L,K) ENDDO ENDDO -c - enddo C C ** UPDATE ZERO DIMENSION VOLUME BALANCE C VOLADD=0. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for index f1a75d126..92dc155f1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for @@ -80,35 +80,20 @@ C OPEN(1,FILE='CBOT.LOG',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA STBXO(L)=STBX(L) STBYO(L)=STBY(L) ENDDO -c - enddo -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC STBX(L)=0. STBY(L)=0. ENDDO DO K=1,KC - DO L=LF,LL + DO L=1,LC FXVEG(L,K)=0. FYVEG(L,K)=0. ENDDO ENDDO -c - enddo -C N=-2 JSTBXY=1 100 CONTINUE @@ -250,91 +235,7 @@ C VISEXP=2./7. VISFAC=0.0258*(COEFTSBL**VISEXP) C - IF(IDRYTBP.EQ.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& UMAGTMP,VMAGTMP,CDMAXU,CDMAXV,VISMUDU,VISMUDV,VISDHU,VISDHV, -!$OMP& SEDTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - IF(ZBR(L).LE.1.E-6)THEN - UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) - VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) - CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) - CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) - VISMUDU=VISMUD - VISMUDV=VISMUD - IF(ISMUD.GE.1)THEN - SEDTMP=0.5*(SED(L,1,1)+SED(L-1,1,1)) - VISMUDU=CSEDVIS(SEDTMP) - SEDTMP=0.5*(SED(L,1,1)+SED(LSC(L),1,1)) - VISMUDV=CSEDVIS(SEDTMP) - ENDIF -C ** DELETED COMMENTED OUT LINES & UNUSED VARIABLES - VISDHU=0.0 - VISDHV=0.0 - IF(UMAGTMP.GT.0.0) VISDHU=(VISMUDU*HUI(L)/UMAGTMP)*VISEXP - IF(VMAGTMP.GT.0.0) VISDHV=(VISMUDV*HVI(L)/VMAGTMP)*VISEXP - STBX(L)=VISFAC*AVCON*STBXO(L)*VISDHU - STBY(L)=VISFAC*AVCON*STBYO(L)*VISDHV - STBX(L)=MIN(CDMAXU,STBX(L)) - STBY(L)=MIN(CDMAXV,STBY(L)) - ENDIF - ENDDO -c - enddo -C -C ** END SMOOTH DRAG FORMULATION -C -C ** BEGIN ROUGH DRAG FORMULATION -C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS,ZBRATU,ZBRATV, -!$OMP& UMAGTMP,VMAGTMP,CDMAXU,CDMAXV,HURTMP,HVRTMP,DZHUDZBR,DZHVDZBR) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - LS=LSC(L) - IF(ZBR(L).GT.1.E-6)THEN - ZBRATU=0.5*(DXP(L-1)*ZBR(L-1)+DXP(L)*ZBR(L))*DXIU(L) - ZBRATV=0.5*(DYP(LS )*ZBR(LS )+DYP(L)*ZBR(L))*DYIV(L) - UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) - VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) - CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) - CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) - !IF(ISDYNSTP.GE.1)THEN ! PMC - !IF(IS2TIM.GE.1)THEN ! PMC - ! CDMAXU=1000. - ! CDMAXV=1000. - !END IF - HURTMP=MAX(ZBRATU,H1U(L)) - HVRTMP=MAX(ZBRATV,H1V(L)) - DZHUDZBR=1.+0.5*DZC(1)*HURTMP/ZBRATU - DZHVDZBR=1.+0.5*DZC(1)*HVRTMP/ZBRATV -C - STBX(L)=AVCON*STBXO(L)*.16/((LOG(DZHUDZBR))**2) - STBY(L)=AVCON*STBYO(L)*.16/((LOG(DZHVDZBR))**2) - STBX(L)=MIN(CDMAXU,STBX(L)) - STBY(L)=MIN(CDMAXV,STBY(L)) - ENDIF - ENDDO -c - enddo - - - ELSE -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& UMAGTMP,VMAGTMP,CDMAXU,CDMAXV,VISMUDU,VISMUDV,VISDHU,VISDHV, -!$OMP& SEDTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN IF(ZBR(L).LE.1.E-6)THEN UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) @@ -361,21 +262,12 @@ C ** DELETED COMMENTED OUT LINES & UNUSED VARIABLES ENDIF ENDIF ENDDO -c - enddo C C ** END SMOOTH DRAG FORMULATION C C ** BEGIN ROUGH DRAG FORMULATION C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS,ZBRATU,ZBRATV, -!$OMP& UMAGTMP,VMAGTMP,CDMAXU,CDMAXV,HURTMP,HVRTMP,DZHUDZBR,DZHVDZBR) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN LS=LSC(L) IF(ZBR(L).GT.1.E-6)THEN @@ -402,10 +294,7 @@ C ENDIF ENDIF ENDDO -c - enddo C - ENDIF C ** END ROUGH DRAG FORMULATION C IF(N.EQ.-2)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index e3a8776fd..a675cbd24 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -37,17 +37,10 @@ C ALLOCATE(POS(0:LCM1,KCM)) ALLOCATE(WQBCCON(0:LCM1,KCM)) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC FWU(L,0)=0. FWU(L,KC)=0. ENDDO -c - enddo CONTMN=0.0 CONTMX=0.0 FQCPAD=0.0 @@ -82,20 +75,7 @@ C IF(IS2TL_.EQ.1)THEN ISUD=1 IF(MVAR.NE.8)THEN -c CON1=CON ! *** ARRAYS -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO K=1,KC - DO L=LF,LL - CON1(L,K)=CON(L,K) - ENDDO - ENDDO -c - enddo - + CON1=CON ! *** ARRAYS ENDIF ENDIF @@ -112,7 +92,7 @@ c C C ** CALCULATED EXTERNAL SOURCES AND SINKS C - CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1,FQCPAD,QSUMPAD,QSUMNAD) + CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1)!,FQCPAD,QSUMPAD,QSUMNAD) C C ** SELECT TRANSPORT OPTION, ISPLIT=1 FOR HORIZONTAL-VERTICAL C ** OPERATOR SPLITTING @@ -129,28 +109,23 @@ C ** AVERAGED BETWEEN (N) AND (N+1) OR (N-1) AND (N+1) AND ADVECTED C ** AT (N) OR (N-1) IF ISTL EQUALS 2 OR 3 RESPECTIVELY C 300 CONTINUE -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(IDRYTBP.EQ.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA FUHU(L,K)=UHDY2(L,K)*CON1(LUPU(L,K),K) FVHU(L,K)=VHDX2(L,K)*CON1(LUPV(L,K),K) ENDDO ENDDO IF(KC.GT.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA FWU(L,K)=W2(L,K)*CON1(L,KUPW(L,K)) ENDDO ENDDO ENDIF ELSE DO K=1,KC - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN FUHU(L,K)=UHDY2(L,K)*CON1(LUPU(L,K),K) FVHU(L,K)=VHDX2(L,K)*CON1(LUPV(L,K),K) @@ -162,7 +137,7 @@ c ENDDO IF(KC.GT.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA IF(LMASKDRY(L))THEN FWU(L,K)=W2(L,K)*CON1(L,KUPW(L,K)) ELSE @@ -172,8 +147,6 @@ c ENDDO ENDIF ENDIF -c - enddo GOTO 500 C C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH ADVECTION @@ -181,39 +154,25 @@ C ** AVERAGED BETWEEN (N-1) AND (N+1) AND ADVECTED FIELD AVERAGED C ** BETWEEN AT (N-1) AND (N) IF ISTL 3 ONLY C 350 CONTINUE -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA CONT(L,K)=0.5*(CON(L,K)+CON1(L,K)) & +DELT*0.5*FQC(L,K)*DXYIP(L)/H2P(L) ENDDO ENDDO -c - enddo -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA FUHU(L,K)=UHDY2(L,K)*CONT(LUPU(L,K),K) FVHU(L,K)=VHDX2(L,K)*CONT(LUPV(L,K),K) ENDDO ENDDO IF(KC.GT.1)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA FWU(L,K)=W2(L,K)*CONT(L,KUPW(L,K)) ENDDO ENDDO ENDIF -c - enddo GOTO 500 C C ** CALCULATE ADVECTIVE FLUXES BY CENTRAL DIFFERENCE WITH TRANSPORT @@ -225,26 +184,13 @@ C PMC DO L=2,LA C PMC CONT(L,K)=CON1(L,K) C PMC ENDDO C PMC ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LS=LSC(L) FUHU(L,K)=0.5*UHDY2(L,K)*(CON(L,K)+CON(L-1,K)) FVHU(L,K)=0.5*VHDX2(L,K)*(CON(L,K)+CON(LS,K)) ENDDO ENDDO - DO K=1,KS - DO L=LF,LL - FWU(L,K)=0.5*W2(L,K)*(CON(L,K+1)+CON(L,K)) - ENDDO - ENDDO -c - enddo - DO K=1,KC DO LL=1,NCBS L=LCBS(LL) @@ -265,6 +211,11 @@ c IF(VHDX2(L,K).GT.0.) FVHU(L,K)=VHDX2(L,K)*CON1(LS,K) ENDDO ENDDO + DO K=1,KS + DO L=2,LA + FWU(L,K)=0.5*W2(L,K)*(CON(L,K+1)+CON(L,K)) + ENDDO + ENDDO C C ** STANDARD ADVECTION CALCULATION C @@ -277,16 +228,11 @@ C ! *** IF ISACAC EQ 0 INCLUDE FQC MASS SOURCES IN UPDATE IF(ISCDCA(MVAR).EQ.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,RDZIC) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISTL_.EQ.2)THEN IF(IDRYTBP.EQ.0)THEN DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA CH(L,K)=CON1(L,K)*H1P(L) & +DELT*( ( RDZIC*FQC(L,K) & +FUHU(L,K)-FUHU(L+1,K) @@ -297,7 +243,7 @@ c ELSE DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA IF(IMASKDRY(L).EQ.0) & CH(L,K)=CON1(L,K)*H1P(L) & +DELT*( ( RDZIC*FQC(L,K)+FUHU(L,K)-FUHU(L+1,K) @@ -313,7 +259,7 @@ c ENDIF IF(ISFCT(MVAR).GE.1.AND.ISADAC(MVAR).GT.0)THEN ! *** DSLLC SINGLE LINE DO K=1,KC - DO L=LF,LL + DO L=2,LA CON2(L,K)=CON1(L,K) ENDDO ENDDO @@ -324,7 +270,7 @@ C ELSE DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA CH(L,K)=CON1(L,K)*H2P(L) & +DELT*( ( RDZIC*FQC(L,K) & +FUHU(L,K)-FUHU(L+1,K) @@ -334,14 +280,12 @@ C ENDDO IF(ISFCT(MVAR).GE.1.AND.ISADAC(MVAR).GT.0)THEN ! *** DSLLC SINGLE LINE DO K=1,KC - DO L=LF,LL + DO L=2,LA CON2(L,K)=CON(L,K) ENDDO ENDDO ENDIF ENDIF -c - enddo C C ENDIF ON TIME LEVEL CHOICE FOR ISCDCA=0 C @@ -351,35 +295,19 @@ C L=LOBCS(IOBC) CON(L,K)=CON1(L,K) ENDDO - ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KC - DO L=LF,LL + DO L=2,LA CON1(L,K)=CON(L,K) ENDDO ENDDO -c - enddo ENDIF ! *** UPDATE NEW CONCENTRATIONS -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA CON(L,K)=CH(L,K)*HPI(L) ENDDO ENDDO -c - enddo C C *** ELSE ON TRANSPORT OPTION CHOICE C *** IF ISACAC NE 0 DO NOT INCLUDE FQC MASS SOURCES IN UPDATE @@ -389,15 +317,10 @@ C C BEGIN IF ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 C IF(ISTL_.EQ.2)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,RDZIC) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(IDRYTBP.EQ.0)THEN DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA CH(L,K)=CON1(L,K)*H1P(L) & +DELT*( ( RDZIC*FQC(L,K) & +FUHU(L,K)-FUHU(L+1,K) @@ -408,7 +331,7 @@ c ELSE DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA IF(IMASKDRY(L).EQ.0) & CH(L,K)=CON1(L,K)*H1P(L) & +DELT*( ( RDZIC*FQC(L,K) @@ -423,9 +346,6 @@ c ENDDO ENDDO ENDIF -c - enddo - IF(ISFCT(MVAR).GE.1)THEN CON2=CON1 ! *** ARRAYS ENDIF @@ -433,23 +353,15 @@ C C ELSE ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 AND ISTL.EQ.3 C ELSE -!$OMP PARALLEL DO PRIVATE(LF,LL,RDZIC) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA CH(L,K)=CON1(L,K)*H2P(L) & +DELT*( ( RDZIC*FQC(L,K)+FUHU(L,K)-FUHU(L+1,K) & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) ENDDO ENDDO -c - enddo - IF(ISFCT(MVAR).GE.1)THEN CON2=CON ! *** ARRAYS ENDIF @@ -458,41 +370,24 @@ C C ENDIF ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 C IF(ISUD.EQ.1.AND.MVAR.NE.8)THEN -!$OMP PARALLEL DO PRIVATE(L) DO K=1,KC DO IOBC=1,NBCSOP L=LOBCS(IOBC) CON(L,K)=CON1(L,K) ENDDO - ENDDO -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KC - DO L=LF,LL + DO L=2,LA CON1(L,K)=CON(L,K) ENDDO ENDDO -c - enddo ENDIF ! *** PMC-BOUNDARY CONDITIONS APPLIED BELOW -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA CON(L,K)=CH(L,K)*HPI(L) ENDDO ENDDO -c - enddo ENDIF C @@ -696,106 +591,41 @@ C ! *** PMC BEGIN BLOCK ! *** GET ONLY POSITIVE CONCENTRATIONS -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c + DO L=2,LA DO K=1,KC - DO L=LF,LL POS(L,K)=MAX(CON(L,K),0.) ENDDO ENDDO -c - enddo ! *** PMC END BLOCK IF(IDRYTBP.EQ.0)THEN + DO K=1,KC + UUU(LC,K)=0.0 + VVV(LC,K)=0.0 + UUU(1,K)=0.0 + VVV(1,K)=0.0 + ENDDO + DO L=1,LC + WWW(L,0)=0.0 + WWW(L,KC)=0.0 + ENDDO C -!$OMP PARALLEL DO PRIVATE(LF,LL,LF_LC,LL_LC,L,K, -!$OMP& RDZIG,LS,AUHU,AVHV) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) - LF_LC=jse_LC(1,ithds) - LL_LC=jse_LC(2,ithds) -c DO K=1,KC - IF(LF.eq.2) THEN - L=1 - UUU(L,K)=0.0 - VVV(L,K)=0.0 - ENDIF - DO L=LF,LL + DO L=2,LA LS=LSC(L) UUU(L,K)=U2(L,K)*(POS(L,K)-POS(L-1,K))*DXIU(L) VVV(L,K)=V2(L,K)*(POS(L,K)-POS(LS,K))*DYIV(L) -c AUHU=ABS(UHDY2(L,K)) -c AVHV=ABS(VHDX2(L,K)) -c UTERM0(L,K)=AUHU*(POS(L,K)-POS(L-1,K)) -c VTERM0(L,K)=AVHV*(POS(L,K)-POS(LS,K)) ENDDO - IF(LL.eq.LA) THEN - L=LC - UUU(L,K)=0.0 - VVV(L,K)=0.0 - ENDIF - ENDDO - K=0 - DO L=LF_LC,LL_LC - WWW(L,K)=0.0 - ENDDO + ENDDO DO K=1,KS RDZIG=DZIG(K) - DO L=LF,LL + DO L=2,LA WWW(L,K)=W2(L,K)*(POS(L,K+1)-POS(L,K))*HPI(L)*RDZIG ENDDO ENDDO - K=KC - DO L=LF_LC,LL_LC - WWW(L,K)=0.0 - ENDDO -c - enddo -c t00=rtc()-t00 -c write(6,*) '==>5C',t00*1d6 -c t00=rtc() - IF(ISADAC(MVAR).GE.2)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,LF_LC,LL_LC, -!$OMP& RDZIC) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) - LF_LC=jse_LC(1,ithds) - LL_LC=jse_LC(2,ithds) -c - DO K=1,KC - RDZIC=DZIC(K) - DO L=LF_LC,LL_LC - SSCORUEWNS(L,K)=DELTA*RDZIC*DXYIP(L)*HPI(L)*(FQCPAD(L,K) - & -QSUMPAD(L,K)*CON(L,K)) - ENDDO - DO L=LF,LL - SSCORWAB(L,K)=DELTA*DZIG(K)*HPI(L)*DXYIP(L) - & *(FQCPAD(L,K )-QSUMPAD(L,K )*POS(L,K )) - ENDDO - ENDDO -c - enddo - ENDIF - -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& RDZIC,LN,LS,LNW,LSE, -!$OMP& AUHU,AVHV,UTERM,VTERM,SSCORUE,SSCORUW,SSCORVN,SSCORVS, -!$OMP& SSCORU,SSCORV,UHU,VHV, -!$OMP& AWW,WTERM,SSCORWA,SSCORWB,SSCORW,WW) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) LNW=LNWC(L) @@ -804,22 +634,15 @@ c AVHV=ABS(VHDX2(L,K)) UTERM=AUHU*(POS(L,K)-POS(L-1,K)) VTERM=AVHV*(POS(L,K)-POS(LS,K)) -c UTERM=UTERM0(L,K) -c VTERM=VTERM0(L,K) IF(ISADAC(MVAR).GE.2)THEN -c SSCORUE=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) -c & -QSUMPAD(L ,K)*CON(L ,K)) -c SSCORUW=DELTA*RDZIC*DXYIP(L-1)*HPI(L-1)*(FQCPAD(L-1,K) -c & -QSUMPAD(L-1,K)*CON(L-1,K)) -c SSCORVN=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) -c & -QSUMPAD(L ,K)*CON(L ,K)) -c SSCORVS=DELTA*RDZIC*DXYIP(LS )*HPI(LS )*(FQCPAD(LS ,K) -c & -QSUMPAD(LS ,K)*CON(LS ,K)) - SSCORUE=SSCORUEWNS(L,K) - SSCORUW=SSCORUEWNS(L-1,K) - SSCORVN=SSCORUEWNS(L,K) - SSCORVS=SSCORUEWNS(LS,K) - + SSCORUE=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORUW=DELTA*RDZIC*DXYIP(L-1)*HPI(L-1)*(FQCPAD(L-1,K) + & -QSUMPAD(L-1,K)*CON(L-1,K)) + SSCORVN=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORVS=DELTA*RDZIC*DXYIP(LS )*HPI(LS )*(FQCPAD(LS ,K) + & -QSUMPAD(LS ,K)*CON(LS ,K)) SSCORU=MAX(UHDY2(L,K),0.0)*SSCORUW+MIN(UHDY2(L,K),0.0) & *SSCORUE SSCORV=MAX(VHDX2(L,K),0.0)*SSCORVS+MIN(VHDX2(L,K),0.0) @@ -863,18 +686,15 @@ c & -QSUMPAD(LS ,K)*CON(LS ,K)) ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) AWW=ABS(W2(L,K)) WTERM=AWW*(POS(L,K+1)-POS(L,K)) IF(ISADAC(MVAR).GE.2)THEN -c SSCORWA=DELTA*DZIG(K+1)*HPI(L)*DXYIP(L) -c & *(FQCPAD(L,K+1)-QSUMPAD(L,K+1)*POS(L,K+1)) -c SSCORWB=DELTA*DZIG(K)*HPI(L)*DXYIP(L) -c & *(FQCPAD(L,K )-QSUMPAD(L,K )*POS(L,K )) - SSCORWA=SSCORWAB(L,K+1) - SSCORWB=SSCORWAB(L,K) - + SSCORWA=DELTA*DZIG(K+1)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K+1)-QSUMPAD(L,K+1)*POS(L,K+1)) + SSCORWB=DELTA*DZIG(K)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K )-QSUMPAD(L,K )*POS(L,K )) SSCORW=MAX(W2(L,K),0.0)*SSCORWB+MIN(W2(L,K),0.0)*SSCORWA WTERM=WTERM+SSCORW ENDIF @@ -899,164 +719,74 @@ c & *(FQCPAD(L,K )-QSUMPAD(L,K )*POS(L,K )) ENDIF ENDDO ENDDO -c - enddo -c t00=rtc()-t00 -c write(6,*) '==>6C',t00*1d6 -c t00=rtc() C C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR SOURCE CELLS C IF(ISADAC(MVAR).EQ.1)THEN ! *** ANTIDIFFUSION TURNED OFF FOR SOURCE CELLS -!$OMP PARALLEL DO PRIVATE(LF,LL,L) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL-1 -c DO L=2,LA + DO L=2,LA IF(QSUMPAD(L,K).GT.0.0)THEN - IF(FUHU(L ,K).NE.0.) FUHU(L ,K)=0. - IF(FUHU(L+1,K).NE.0.) FUHU(L+1,K)=0. - IF(FVHU(L ,K).NE.0.) FVHU(L ,K)=0. - IF(FWU(L,K ).NE.0.) FWU(L,K )=0. - IF(FWU(L,K-1).NE.0.) FWU(L,K-1)=0. - ENDIF - ENDDO - ENDDO - enddo -c - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KC - L=LL - IF(QSUMPAD(L,K).GT.0.0)THEN - IF(FUHU(L ,K).NE.0.) FUHU(L ,K)=0. - IF(FUHU(L+1,K).NE.0.) FUHU(L+1,K)=0. - IF(FVHU(L ,K).NE.0.) FVHU(L ,K)=0. - IF(FWU(L,K ).NE.0.) FWU(L,K )=0. - IF(FWU(L,K-1).NE.0.) FWU(L,K-1)=0. - ENDIF - ENDDO - enddo - - -!$OMP PARALLEL DO PRIVATE(LF,LL,LN,ii) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KC - ii=0 - DO L=LF,LL - IF(QSUMPAD(L,K).GT.0.0)THEN LN=LNC(L) - IF(LN.NE.LC) THEN - IF(FVHU(LN ,K).NE.0.) FVHU(LN ,K)=0. - ELSE - ii=ii+1 - ENDIF + FUHU(L ,K)=0. + FUHU(L+1,K)=0. + FVHU(L ,K)=0. + FVHU(LN ,K)=0. + FWU(L,K )=0. + FWU(L,K-1)=0. ENDIF ENDDO - icount(ithds,K)=ii ENDDO - enddo - DO K=1,KC - ii=0 - do ithds=0,nthds-1 - ii=ii+icount(ithds,K) - enddo - if(ii.gt.0) then - LN=LC - FVHU(LN ,K)=0. - endif - ENDDO - ENDIF C C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR OPEN BOUNDARY CELLS C + DO K=1,KC DO LL=1,NCBS L=LCBS(LL) LN=LNC(L) - DO K=1,KC FVHU(LN,K)=0.0 ENDDO - ENDDO - DO LL=1,NCBW - L=LCBW(LL) - DO K=1,KC - FUHU(L+1,K)=0.0 + DO LL=1,NCBW + L=LCBW(LL) + FUHU(L+1,K)=0.0 ENDDO - ENDDO - DO LL=1,NCBE - L=LCBE(LL) - DO K=1,KC - FUHU(L,K)=0.0 + DO LL=1,NCBE + L=LCBE(LL) + FUHU(L,K)=0.0 ENDDO - ENDDO - DO LL=1,NCBN - L=LCBN(LL) - DO K=1,KC + DO LL=1,NCBN + L=LCBN(LL) FVHU(L,K)=0.0 - ENDDO ENDDO + ENDDO C C ** CALCULATE AND APPLY FLUX CORRECTED TRANSPORT LIMITERS C -c t00=rtc()-t00 -c write(6,*) '==>7C',t00*1d6 -c t00=rtc() IF(ISFCT(MVAR).EQ.0) GOTO 1100 C C ** DETERMINE MAX AND MIN CONCENTRATIONS C -!$OMP PARALLEL DO PRIVATE(LF,LL,L) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - IF(LF.eq.2) THEN - L=1 + DO L=1,LC CONTMX(L,K)=0.0 CONTMN(L,K)=0.0 - ENDIF - DO L=LF,LL + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA CONTMX(L,K)=MAX(CON(L,K),CON2(L,K)) CONTMN(L,K)=MIN(CON(L,K),CON2(L,K)) ENDDO - IF(LL.eq.LA) THEN - L=LC - CONTMX(L,K)=0.0 - CONTMN(L,K)=0.0 - ENDIF ENDDO -c - enddo -c t00=rtc()-t00 -c write(6,*) '==>8C',t00*1d6 -c t00=rtc() - -!$OMP PARALLEL DO PRIVATE(LF,LL,K, -!$OMP& LS,LN, -!$OMP& CWMAX,CEMAX,CSMAX,CNMAX,CMAXT,CWMIN,CEMIN,CSMIN,CNMIN,CMINT) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA CMAX(L,1)=MAX(CONTMX(L,1),CONTMX(L,2)) CMAX(L,KC)=MAX(CONTMX(L,KS),CONTMX(L,KC)) CMIN(L,1)=MIN(CONTMN(L,1),CONTMN(L,2)) CMIN(L,KC)=MIN(CONTMN(L,KS),CONTMN(L,KC)) ENDDO DO K=2,KS - DO L=LF,LL + DO L=2,LA CMAXT=MAX(CONTMX(L,K-1),CONTMX(L,K+1)) CMAX(L,K)=MAX(CONTMX(L,K),CMAXT) CMINT=MIN(CONTMN(L,K-1),CONTMN(L,K+1)) @@ -1064,7 +794,7 @@ c ENDDO ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA LS=LSC(L) LN=LNC(L) CWMAX=SUB(L)*CONTMX(L-1,K) @@ -1085,13 +815,12 @@ c CMIN(L,K)=MIN(CMIN(L,K),CMINT) ENDDO ENDDO - C C ** SEPARATE POSITIVE AND NEGATIVE FLUXES PUTTING NEGATIVE FLUXES C ** INTO FUHV, FVHV, AND FWV C DO K=1,KC - DO L=LF,LL + DO L=2,LA FUHV(L,K)=MIN(FUHU(L,K),0.) FUHU(L,K)=MAX(FUHU(L,K),0.) FVHV(L,K)=MIN(FVHU(L,K),0.) @@ -1099,29 +828,18 @@ C ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA FWV(L,K)=MIN(FWU(L,K),0.) FWU(L,K)=MAX(FWU(L,K),0.) ENDDO ENDDO -c - enddo -c t00=rtc()-t00 -c write(6,*) '==>9C',t00*1d6 -c t00=rtc() C C ** CALCULATE INFLUX AND OUTFLUX IN CONCENTRATION UNITS AND LOAD C ** INTO DU AND DV, THEN ADJUCT VALUES AT BOUNDARIES C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& RDZIC,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA LN=LNC(L) DU(L,K)=DELT*(DXYIP(L)*(FUHU(L,K)-FUHV(L+1,K) & +FVHU(L,K)-FVHV(LN,K)) @@ -1131,45 +849,33 @@ c & +RDZIC*(FWU(L,K)-FWV(L,K-1)) )*HPI(L) ENDDO ENDDO -c - enddo - -c t00=rtc()-t00 -c write(6,*) '==>10C',t00*1d6 -c t00=rtc() + DO K=1,KC DO IOBC=1,NBCSOP L=LOBCS(IOBC) - DO K=1,KC DU(L,K)=0. DV(L,K)=0. ENDDO END DO + DO K=1,KC DO LL=1,NCBS L=LCBS(LL) LN=LNC(L) - DO K=1,KC DU(LN,K)=0. DV(LN,K)=0. ENDDO - ENDDO DO LL=1,NCBW L=LCBW(LL) - DO K=1,KC DU(L+1,K)=0. DV(L+1,K)=0. ENDDO - ENDDO DO LL=1,NCBE L=LCBE(LL) DU(L-1,K)=0. - DO K=1,KC DV(L-1,K)=0. ENDDO - ENDDO DO LL=1,NCBN L=LCBN(LL) LS=LSC(L) - DO K=1,KC DU(LS,K)=0. DV(LS,K)=0. ENDDO @@ -1177,65 +883,19 @@ c t00=rtc() C C ** CALCULATE BETA COEFFICIENTS WITH BETAUP AND BETADOWN IN DU AND DV C -!$OMP PARALLEL DO PRIVATE(LF,LL,BB) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL - IF(DU(L,K).GT.0.) THEN - IF((CMAX(L,K)-POS(L,K)).LT.(DU(L,K)+BSMALL)) THEN - BB=(CMAX(L,K)-POS(L,K))/(DU(L,K)+BSMALL) - ELSE - BB=1. - ENDIF - ELSE - BB=MIN(DU(L,K),1.) - ENDIF - DU(L,K)=BB -c IF(DU(L,K).GT.0.)DU(L,K)=(CMAX(L,K)-POS(L,K))/(DU(L,K)+BSMALL) -c DU(L,K)=MIN(DU(L,K),1.) -c if(BB.ne.DU(L,K)) THEN -c cc write(6,*) BB,DU(L,K) -c stop 10 -c endif - IF(DV(L,K).GT.0.) THEN - IF((CON(L,K)-CMIN(L,K)).LT.(DV(L,K)+BSMALL)) THEN - BB=(CON(L,K)-CMIN(L,K))/(DV(L,K)+BSMALL) - ELSE - BB=1. - ENDIF - ELSE - BB=MIN(DV(L,K),1.) - ENDIF - DV(L,K)=BB - -c IF(DV(L,K).GT.0.)DV(L,K)=(CON(L,K)-CMIN(L,K))/(DV(L,K)+BSMALL) -c DV(L,K)=MIN(DV(L,K),1.) -c if(BB.ne.DV(L,K)) THEN -c cc write(6,*) BB,DV(L,K) -c stop 10 -c endif - + DO L=2,LA + IF(DU(L,K).GT.0.)DU(L,K)=(CMAX(L,K)-POS(L,K))/(DU(L,K)+BSMALL) + DU(L,K)=MIN(DU(L,K),1.) + IF(DV(L,K).GT.0.)DV(L,K)=(CON(L,K)-CMIN(L,K))/(DV(L,K)+BSMALL) + DV(L,K)=MIN(DV(L,K),1.) ENDDO ENDDO -c - enddo C -c t00=rtc()-t00 -c write(6,*) '==>11C',t00*1d6 -c t00=rtc() C ** LIMIT FLUXES C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LS=LSC(L) FUHU(L,K)=MIN(DV(L-1,K),DU(L,K))*FUHU(L,K) & +MIN(DU(L-1,K),DV(L,K))*FUHV(L,K) @@ -1244,30 +904,19 @@ c ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA FWU(L,K)=MIN(DV(L,K),DU(L,K+1))*FWU(L,K) & +MIN(DU(L,K),DV(L,K+1))*FWV(L,K) ENDDO ENDDO -c - enddo C C ** ANTI-DIFFUSIVE ADVECTION CALCULATION C 1100 CONTINUE C -c t00=rtc()-t00 -c write(6,*) '==>12C',t00*1d6 -c t00=rtc() -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& RDZIC) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC RDZIC=DZIC(K) - DO L=LF,LL + DO L=2,LA CH(L,K)=CON(L,K)*HP(L) & +DELT*( (FUHU(L,K)-FUHU(L+1,K) & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) @@ -1275,19 +924,14 @@ c CON(L,K)=SCB(L)*CH(L,K)*HPI(L)+(1.-SCB(L))*CON(L,K) ENDDO ENDDO -c - enddo C C ** ADD REMAINING SEDIMENT SETTLING AND FLUX C ENDIF -c t00=rtc()-t00 -c write(6,*) '==>13C',t00*1d6 C C ** ANTI-DIFFUSIVE ADVECTIVE FLUX CALCULATION WITH DRY BYPASS C IF(IDRYTBP.GT.0)THEN -c t00=rtc() ! *** DSLLC BEGIN DO L=1,LC WWW(L,0)=0.0 @@ -1434,6 +1078,17 @@ C C C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR SOURCE CELLS C + if(n.gt.2400.AND..FALSE.)then ! PMC PMC + L = 6795 + k = 1 + write(*,9999)n,con(l-1,k),con(l,k),con(l+1,k), + 1 fuhu(l-1,k),fuhu(l,k),fuhu(l+1,k), + 1 UHDY2(l-1,k),UHDY2(l,k),UHDY2(l+1,k), + 1 VHDX2(l-1,k),VHDX2(l,k),VHDX2(l+1,k) + ! 1 fwu(l-1,k),fwu(l,k),fwu(l+1,k) + 9999 format(i5,6f12.2/5x,6f12.2) + endif + IF(ISADAC(MVAR).EQ.1)THEN DO K=1,KC DO L=2,LA @@ -1690,34 +1345,21 @@ C ! *** ZERO HEAT FLUXES 2000 IF(MVAR.EQ.2)THEN -c t00=rtc() -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c ! *** ZERO EVAP/RAINFALL - DO L=LF,LL + DO L=1,LC FQC(L,KC)=0. ENDDO IF(ISADAC(MVAR).GE.2)THEN - DO L=LF,LL + DO L=1,LC FQCPAD(L,KC)=0. ENDDO ENDIF IF(ISADAC(MVAR).GT.0)THEN - DO L=LF,LL + DO L=1,LC QSUMPAD(L,KC)=0. ENDDO ENDIF -c - enddo ENDIF - DEALLOCATE(UTERM0) - DEALLOCATE(VTERM0) - DEALLOCATE(SSCORUEWNS) - DEALLOCATE(SSCORWAB) - RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for index d376685af..6ff3ac146 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for @@ -392,12 +392,7 @@ C IF(NASER.GT.0)THEN ENDDO ENDDO ELSE -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA PATMT(L)=PATMTT(1) TATMT(L)=TATMTT(1) RAINT(L)=RAINTT(1) @@ -408,19 +403,12 @@ c RHA(L)=RHAT(1) VPA(L)=VPAT(1) ENDDO -c - enddo ENDIF ! *** PMC - MOVED ALL TIME INVARIANT PARAMETERS TO KEEP FROM COMPUTING EVERY TIME -!$OMP PARALLEL DO PRIVATE(LF,LL,CLEVAPTMP,CCNHTTTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(REVC.LT.0.)THEN CLEVAPTMP=0.001*ABS(REVC) - DO L=LF,LL + DO L=2,LA CLEVAP(L)=1.E-3*(0.8+0.065*WINDST(L)) CLEVAP(L)=MAX(CLEVAP(L),CLEVAPTMP) ENDDO @@ -428,13 +416,11 @@ c IF(RCHC.LT.0.)THEN CCNHTTTMP=0.001*ABS(RCHC) - DO L=LF,LL + DO L=2,LA CCNHTT(L)=1.E-3*(0.8+0.065*WINDST(L)) CCNHTT(L)=MAX(CCNHTT(L),CCNHTTTMP) ENDDO ENDIF -c - enddo ENDIF C RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for index 129467f0f..1615637de 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for @@ -23,17 +23,8 @@ C C C ** CALCULATE BOTTOM FRICTION COEFFICIENT C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& Q1,Q2, -!$OMP& RCDZM,RCDZU,RCDZL,CMU,CMV,EU,EV, -!$OMP& RCDZR,CRU,CRV, -!$OMP& RDZG,RCDZD) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISTL_.EQ.3)THEN - DO L=LF,LL + DO L=2,LA RCX(L)=AVCON1/H1U(L)+STBX(L)*SQRT(U1(L,1)*U1(L,1) & +V1U(L)*V1U(L)) RCY(L)=AVCON1/H1V(L)+STBY(L)*SQRT(U1V(L)*U1V(L) @@ -44,7 +35,7 @@ C LF=2+(ND-1)*LDM C ELSE IF(AVCON1.LT.0.00001)THEN - DO L=LF,LL + DO L=2,LA ! *** FOR 2TL U1 & U AND V1 & V ARE THE SAME ! *** THESE ARE ONLY DIFFERENCE FOR 3TL ISTL=2 TRAP CORRECTION STEP Q1=SQRT(U1(L,1)*U1(L,1)+V1U(L)*V1U(L)) @@ -55,7 +46,7 @@ C RCY(L)=STBY(L)*SQRT(Q1*Q2) ENDDO ELSE - DO L=LF,LL + DO L=2,LA Q1=SQRT(U1(L,1)*U1(L,1)+V1U(L)*V1U(L)) Q2=SQRT(U(L,1)*U(L,1)+VU(L)*VU(L)) RCX(L)=AVCON1/SQRT(H1U(L)*HU(L))+STBX(L)*SQRT(Q1*Q2) @@ -74,7 +65,7 @@ C RCDZM=CDZM(1)*DELTI RCDZU=CDZU(1) RCDZL=CDZL(1) - DO L=LF,LL + DO L=2,LA CMU=1.+RCDZM*HU(L)*AVUI(L,1) CMV=1.+RCDZM*HV(L)*AVVI(L,1) EU=1./CMU @@ -90,7 +81,7 @@ C RCDZM=CDZM(K)*DELTI RCDZU=CDZU(K) RCDZL=CDZL(K) - DO L=LF,LL + DO L=2,LA CMU=1.+RCDZM*HU(L)*AVUI(L,K) CMV=1.+RCDZM*HV(L)*AVVI(L,K) EU=1./(CMU-RCDZL*CU1(L,K-1)) @@ -104,14 +95,14 @@ C ENDDO ENDDO DO K=KS-1,1,-1 - DO L=LF,LL + DO L=2,LA DU(L,K)=DU(L,K)-CU1(L,K)*DU(L,K+1) DV(L,K)=DV(L,K)-CU2(L,K)*DV(L,K+1) UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA AAU(L)=0. AAV(L)=0. BBU(L)=1. @@ -119,7 +110,7 @@ C ENDDO DO K=1,KS RCDZR=CDZR(K) - DO L=LF,LL + DO L=2,LA CRU=RCDZR*RCX(L)*AVUI(L,K) CRV=RCDZR*RCY(L)*AVVI(L,K) AAU(L)=AAU(L)+CRU*DU(L,K) @@ -128,36 +119,40 @@ C BBV(L)=BBV(L)+CRV*VVV(L,K) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA AAU(L)=AAU(L)/BBU(L) AAV(L)=AAV(L)/BBV(L) ENDDO DO K=1,KS RDZG=DZG(K) - RCDZD=CDZD(K) - DO L=LF,LL + DO L=2,LA DU(L,K)=RDZG*HU(L)*AVUI(L,K)*(DU(L,K)-AAU(L)*UUU(L,K)) DV(L,K)=RDZG*HV(L)*AVVI(L,K)*(DV(L,K)-AAV(L)*VVV(L,K)) + ENDDO + ENDDO C C ** CALCULATED U AND V C ** DUSUM+UHE=UHE, DVSUM+VHE=VHE C + DO K=1,KS + RCDZD=CDZD(K) + DO L=2,LA UHE(L)=UHE(L)+RCDZD*DU(L,K) VHE(L)=VHE(L)+RCDZD*DV(L,K) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA UHDY(L,KC)=UHE(L)*SUB(L) VHDX(L,KC)=VHE(L)*SVB(L) ENDDO DO K=KS,1,-1 - DO L=LF,LL + DO L=2,LA UHDY(L,K)=UHDY(L,K+1)-DU(L,K)*SUB(L) VHDX(L,K)=VHDX(L,K+1)-DV(L,K)*SVB(L) ENDDO ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA U(L,K)=UHDY(L,K)*HUI(L) V(L,K)=VHDX(L,K)*HVI(L) UHDY(L,K)=UHDY(L,K)*DYU(L) @@ -167,22 +162,26 @@ C C C ** ADD ADJUSTMENT TO 3D HORIZONTAL TRANSPORT C - DO L=LF,LL + DO L=2,LA TVAR3E(L)=0. TVAR3N(L)=0. ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR3E(L)=TVAR3E(L)+UHDY(L,K)*DZC(K) TVAR3N(L)=TVAR3N(L)+VHDX(L,K)*DZC(K) ENDDO ENDDO - DO L=LF,LL + UERMX=-1.E+12 + UERMN=1.E+12 + VERMX=-1.E+12 + VERMN=1.E+12 + DO L=2,LA TVAR3E(L)=TVAR3E(L)-UHDYE(L) TVAR3N(L)=TVAR3N(L)-VHDXE(L) ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA UHDY(L,K)=UHDY(L,K)-TVAR3E(L)*DZIC(K) VHDX(L,K)=VHDX(L,K)-TVAR3N(L)*DZIC(K) ENDDO @@ -190,26 +189,28 @@ C C C ** RESET VELOCITIES C - DO L=LF,LL + DO L=2,LA UHE(L)=0. VHE(L)=0. ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA UHE(L)=UHE(L)+UHDY(L,K)*DZC(K) VHE(L)=VHE(L)+VHDX(L,K)*DZC(K) U(L,K)=UHDY(L,K)*HUI(L) V(L,K)=VHDX(L,K)*HVI(L) + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA U(L,K)=U(L,K)*DYIU(L) V(L,K)=V(L,K)*DXIV(L) ENDDO ENDDO - DO L=LF,LL + DO L=2,LA UHE(L)=UHE(L)*DYIU(L) VHE(L)=VHE(L)*DXIV(L) ENDDO -c - enddo C C ** UNCOMMENT BELOW TO WRITE CONTINUITY DIAGNOSITCS C @@ -220,20 +221,15 @@ C C C ** CALCULATE W C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN,LE) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISTL_.EQ.3)THEN - DO L=LF,LL + DO L=2,LA TVAR3E(L)=UHDYE(L+1 ) TVAR3N(L)=VHDXE(LNC(L)) TVAR3W(L)=UHDY2E(L+1 ) TVAR3S(L)=VHDX2E(LNC(L)) ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR1E(L,K)=UHDY(L+1 ,K) TVAR1N(L,K)=VHDX(LNC(L),K) TVAR1W(L,K)=UHDY2(L+1 ,K) @@ -241,7 +237,7 @@ c ENDDO ENDDO DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) W(L,K)=W(L,K-1) - 0.5*DZC(K)*DXYIP(L)* & (TVAR1E(L,K)-UHDY(L,K)-TVAR3E(L)+UHDYE(L) @@ -255,7 +251,7 @@ c ELSEIF(ISTL_.EQ.2)THEN DO K=1,KS - DO L=LF,LL + DO L=2,LA LN=LNC(L) LE=L+1 W(L,K)=W(L,K-1) - 0.5*DZC(K)*DXYIP(L)* @@ -264,11 +260,10 @@ c & + VHDX(LN,K)- VHDX(L,K)- VHDXE(LN)+VHDXE(L) & +VHDX1(LN,K)-VHDX1(L,K)-VHDX1E(LN)+VHDX1E(L)) & +(QSUM(L,K)-DZC(K)*QSUME(L) )*DXYIP(L) + iii=0 ENDDO ENDDO ENDIF -c - enddo ! *** APPLY OPEN BOUNDARYS DO LL=1,NBCSOP @@ -298,6 +293,8 @@ C V(LN,K)=0. ENDIF ENDDO + ENDDO + DO K=1,KC DO LL=1,NCBW L=LCBW(LL) LP=L+1 @@ -310,11 +307,15 @@ C U(LP,K)=0. ENDIF ENDDO + ENDDO + DO K=1,KC DO LL=1,NCBE L=LCBE(LL) UHDY(L,K)=UHDY(L-1,K)-UHDYE(L-1)+UHDYE(L) U(L,K)=UHDY(L,K)/(HU(L)*DYU(L)) ENDDO + ENDDO + DO K=1,KC DO LL=1,NCBN L=LCBN(LL) LS=LSC(L) @@ -326,14 +327,9 @@ C C ** CALCULATE AVERAGE CELL FACE TRANSPORTS FOR SALT, TEMPERATURE AND C ** SEDIMENT TRANSPORT AND PLACE IN UHDY2, VHDX2 AND W2 C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN,LE) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISTL_.EQ.2)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA UHDY2(L,K)=0.5*(UHDY(L,K)+UHDY1(L,K)) VHDX2(L,K)=0.5*(VHDX(L,K)+VHDX1(L,K)) U2(L,K)=0.5*(U(L,K)+U1(L,K)) @@ -343,7 +339,7 @@ c ENDDO ELSE DO K=1,KC - DO L=LF,LL + DO L=2,LA UHDY2(L,K)=0.5*(UHDY(L,K)+UHDY2(L,K)) VHDX2(L,K)=0.5*(VHDX(L,K)+VHDX2(L,K)) U2(L,K)=0.5*(U(L,K)+U2(L,K)) @@ -355,7 +351,7 @@ c C IF(ISWVSD.GE.1)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA UHDY2(L,K)=UHDY2(L,K)+DYU(L)*UVPT(L,K) VHDX2(L,K)=VHDX2(L,K)+DXV(L)*VVPT(L,K) U2(L,K)=U2(L,K)+UVPT(L,K)/HMU(L) @@ -368,27 +364,18 @@ C C ** ADDITIONAL 3D CONTINUITY ADJUSTED ADDED BELOW C IF(KC.GT.1)THEN - DO L=LF,LL + DO L=2,LA TVAR3E(L)=0. TVAR3N(L)=0. ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA TVAR3E(L)=TVAR3E(L)+UHDY2(L,K)*DZC(K) TVAR3N(L)=TVAR3N(L)+VHDX2(L,K)*DZC(K) ENDDO ENDDO - ENDIF -C - enddo - IF(KC.GT.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,LN,HPPTMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(ISTL_.EQ.3)THEN - DO L=LF,LL + DO L=2,LA LN=LNC(L) HPPTMP=H2P(L)+DELT*DXYIP(L)*( QSUME(L) & -TVAR3E(L+1)+TVAR3E(L) @@ -399,7 +386,7 @@ c HPI(L)=1./HP(L) ENDDO ELSE - DO L=LF,LL + DO L=2,LA LN=LNC(L) HPPTMP=H1P(L)+DELT*DXYIP(L)*( QSUME(L) & -TVAR3E(L+1)+TVAR3E(L) @@ -410,8 +397,6 @@ c HPI(L)=1./HP(L) ENDDO ENDIF -C - enddo IF(MDCHH.GE.1)THEN RLAMN=QCHERR RLAMO=1.-RLAMN @@ -441,14 +426,8 @@ C ** ACCUMULTATE MAX COURANT NUMBERS C C *** DSLLC BEGIN BLOCK IF(ISINWV.EQ.1.OR.ISNEGH.GT.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& CFLUUUT,CFLVVVT,CFLWWWT,CFLCACT) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA CFLUUUT=DELT*ABS(DXIU(L)*U(L,K)) CFLUUU(L,K)=MAX(CFLUUUT,CFLUUU(L,K)) CFLVVVT=DELT*ABS(DYIV(L)*V(L,K)) @@ -459,8 +438,6 @@ c CFLCAC(L,K)=MAX(CFLCACT,CFLCAC(L,K)) ENDDO ENDDO -c - enddo ENDIF C *** DSLLC END BLOCK C @@ -472,8 +449,8 @@ C ** WRITE TO DIAGNOSTIC FILE CFL.OUT WITH DIAGNOSTICS OF MAXIMUM C ** TIME STEP C ** SEDIMENT TRANSPORT AND PLACE IN UHDY2, VHDX2 AND W2 C -! IF(ISCFL.GE.1.AND.ISTL_.EQ.3.AND.DEBUG)THEN ! GEOSR. 2011.11.29 - IF(ISCFL.GE.1.AND.DEBUG)THEN ! GEOSR. 2011.11.29 +! IF(ISCFL.GE.1.AND.ISTL_.EQ.3.AND.DEBUG)THEN + IF(ISCFL.GE.1)THEN OPEN(1,FILE='CFL.OUT',STATUS='UNKNOWN',POSITION='APPEND') IF(ISCFLM.GE.1.AND.N.EQ.1)THEN OPEN(2,FILE='CFLMP.OUT',STATUS='UNKNOWN') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for index 1d48a74e3..2ca1cee4b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for @@ -40,18 +40,9 @@ C ** CALLS TO SOURCE-SINK CALCULATIONS C ** BYPASS OR INITIALIZE VERTICAL DIFFUSION CALCULATION C IF(KC.EQ.1) GOTO 2000 -! -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -! - DO L=LF,LL + DO L=2,LA HWQI(L)=1./HWQ(L) ENDDO -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO TTMP=SECNDS(0.0) C C ** VERTICAL DIFFUSION CALCULATION LEVEL 1 @@ -323,15 +314,10 @@ C C ** VERTICAL DIFFUSION CALCULATION LEVEL 3 C ELSEIF(ISWQLVL.EQ.3)THEN -! -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& RCDZKK,CCUBTMP,CCMBTMP,EEB, -!$OMP& RCDZKMK,CCLBTMP, NSP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -! RCDZKK=-DELT*CDZKK(1) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO L=LF,LL CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) CCMBTMP=1.-CCUBTMP @@ -371,6 +357,11 @@ C ENDDO enddo endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO K=2,KS RCDZKMK=-DELT*CDZKMK(K) RCDZKK=-DELT*CDZKK(K) @@ -421,8 +412,13 @@ C enddo enddo endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO K=KC RCDZKMK=-DELT*CDZKMK(K) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO L=LF,LL CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) CCMBTMP=1.-CCLBTMP @@ -461,6 +457,11 @@ C ENDDO enddo endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 DO K=KC-1,1,-1 DO L=LF,LL WQV(L,K, 1)=WQV(L,K, 1)-CU1(L,K)*WQV(L,K+1, 1) @@ -496,9 +497,7 @@ C enddo enddo endif -! - enddo !do ithds=0,nthds-1 -!$OMP END PARALLEL DO + ENDDO ENDIF TWQDIF=TWQDIF+SECNDS(TTMP) 2000 CONTINUE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for index d9ec90a78..9c0367724 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for @@ -104,31 +104,37 @@ C ELSE LNC(L)=LIJ(I,J+1) ENDIF +! IF(LNC(L).EQ.0) LNC(L)=LC IF(IJCT(I,J-1).EQ.9)THEN LSC(L)=LC ELSE LSC(L)=LIJ(I,J-1) ENDIF +! IF(LSC(L).EQ.0) LSC(L)=LC IF(IJCT(I+1,J+1).EQ.9)THEN LNEC(L)=LC ELSE LNEC(L)=LIJ(I+1,J+1) ENDIF +! IF(LNEC(L).EQ.0) LNEC(L)=LC IF(IJCT(I-1,J+1).EQ.9)THEN LNWC(L)=LC ELSE LNWC(L)=LIJ(I-1,J+1) ENDIF +! IF(LNWC(L).EQ.0) LNWC(L)=LC IF(IJCT(I+1,J-1).EQ.9)THEN LSEC(L)=LC ELSE LSEC(L)=LIJ(I+1,J-1) ENDIF +! IF(LSEC(L).EQ.0) LSEC(L)=LC IF(IJCT(I-1,J-1).EQ.9)THEN LSWC(L)=LC ELSE LSWC(L)=LIJ(I-1,J-1) ENDIF +! IF(LSWC(L).EQ.0) LSWC(L)=LC ENDDO C C ** MODIFY NORTH-SOUTH CELL MAPPING FOR PERIOD GRID IN N-S DIRECTION diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for index 2590c450c..192c96c4a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for @@ -9,88 +9,68 @@ C REAL TTMP, SECNDS ! *** DSLLC + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PNORTH + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PSOUTH REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPCG - IF(.NOT.ALLOCATED(TMPCG))THEN + IF(.NOT.ALLOCATED(PNORTH))THEN + ALLOCATE(PNORTH(LCM)) + ALLOCATE(PSOUTH(LCM)) ALLOCATE(TMPCG(LCM)) + PNORTH=0.0 + PSOUTH=0.0 TMPCG=0.0 ENDIF ! *** DSLLC C TTMP=SECNDS(0.0) - RPCG=0. -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(+:RPCG) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - RCG(L)=FPTMP(L)-CCC(L)*P(L) - & -CCN(L)*P(LNC(L))-CCS(L)*P(LSC(L)) + DO L=2,LA + PNORTH(L)=P(LNC(L)) + PSOUTH(L)=P(LSC(L)) + ENDDO + DO L=2,LA + RCG(L)=FPTMP(L)-CCC(L)*P(L)-CCN(L)*PNORTH(L)-CCS(L)*PSOUTH(L) & -CCW(L)*P(L-1)-CCE(L)*P(L+1) + ENDDO + DO L=2,LA PCG(L)=RCG(L)*CCCI(L) + ENDDO + RPCG=0.0 + DO L=2,LA RPCG=RPCG+RCG(L)*PCG(L) ENDDO - -c - enddo - IF(RPCG.EQ.0.0)RETURN ! *** DSLLC SINGLE LINE ITER=0 100 CONTINUE ITER=ITER+1 - PAPCG=0. -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(+:PAPCG) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - APCG(L)=CCC(L)*PCG(L) - & +CCS(L)*PCG(LSC(L))+CCN(L)*PCG(LNC(L)) + DO L=2,LA + PNORTH(L)=PCG(LNC(L)) + PSOUTH(L)=PCG(LSC(L)) + ENDDO + DO L=2,LA + APCG(L)=CCC(L)*PCG(L)+CCS(L)*PSOUTH(L)+CCN(L)*PNORTH(L) & +CCW(L)*PCG(L-1)+CCE(L)*PCG(L+1) + ENDDO + PAPCG=0.0 + DO L=2,LA PAPCG=PAPCG+APCG(L)*PCG(L) ENDDO - -c - enddo - -c t01=rtc() ALPHA=RPCG/PAPCG - - RPCGN=0. - RSQ=0. -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(+:RPCGN,RSQ) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA P(L)=P(L)+ALPHA*PCG(L) + ENDDO + DO L=2,LA RCG(L)=RCG(L)-ALPHA*APCG(L) + ENDDO + DO L=2,LA TMPCG(L)=CCCI(L)*RCG(L) + ENDDO + RPCGN=0. + RSQ=0. + DO L=2,LA RPCGN=RPCGN+RCG(L)*TMPCG(L) RSQ=RSQ+RCG(L)*RCG(L) ENDDO -c - enddo - - IF(RSQ .LE. RSQM) GOTO 200 - IF(ITER .LT. ITERM)THEN - BETA=RPCGN/RPCG - RPCG=RPCGN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - PCG(L)=TMPCG(L)+BETA*PCG(L) - ENDDO -c - enddo - GOTO 100 - ENDIF IF(ITER .GE. ITERM)THEN WRITE(6,600) C @@ -110,6 +90,12 @@ C CLOSE(8) STOP ENDIF + BETA=RPCGN/RPCG + RPCG=RPCGN + DO L=2,LA + PCG(L)=TMPCG(L)+BETA*PCG(L) + ENDDO + GOTO 100 600 FORMAT(' MAXIMUM ITERATIONS EXCEEDED IN EXTERNAL SOLUTION') C C ** CALCULATE FINAL RESIDUAL @@ -117,22 +103,21 @@ C 200 CONTINUE ! *** DSLLC BEGIN BLOCK IF(ISLOG.GE.1)THEN + DO L=2,LA + PNORTH(L)=P(LNC(L)) + PSOUTH(L)=P(LSC(L)) + ENDDO RSQ=0. -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(+:RSQ) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL - RCG(L)=CCC(L)*P(L) - & +CCS(L)*P(LSC(L))+CCN(L)*P(LNC(L)) + DO L=2,LA + RCG(L)=CCC(L)*P(L)+CCS(L)*PSOUTH(L)+CCN(L)*PNORTH(L) & +CCW(L)*P(L-1)+CCE(L)*P(L+1)-FPTMP(L) + ENDDO + DO L=2,LA RCG(L)=RCG(L)*CCCI(L) + ENDDO + DO L=2,LA RSQ=RSQ+RCG(L)*RCG(L) ENDDO -c - enddo - ENDIF ! *** DSLLC END BLOCK TCONG=TCONG+SECNDS(TTMP) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for index 1184e165c..ca07b88ad 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for @@ -127,7 +127,7 @@ C C C ** CALCULATED EXTERNAL SOURCES AND SINKS C - CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1,FQCPAD,QSUMPAD,QSUMNAD) + CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1)!,FQCPAD,QSUMPAD,QSUMNAD) C C ** BEGIN COMBINED ADVECTION SCHEME C ** INTERMEDIATE ADVECTION CALCULATIONS diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for index ac46abd1a..afcc29cf1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for @@ -160,7 +160,7 @@ C ** CALCULATED EXTERNAL SOURCES AND SINKS C C----------------------------------------------------------------------C C - CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1,FQCPAD,QSUMPAD,QSUMNAD) + CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1)!,FQCPAD,QSUMPAD,QSUMNAD) C IF(ISTRAN(M).EQ.1) CALL CALFQC (ISTL_,M,CON,CON1) C IF(ISTRAN(M).EQ.3) CALL CALFQC (ISTL_,M,CON,CON1) C IF(M.EQ.4)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index f659ed1dc..63072c53f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -1048,15 +1048,7 @@ C ENDIF C IF(BSC.GT.1.E-6)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - CALL CALBUOY(LF,LL) -c - enddo - + CALL CALBUOY ELSE DO K=1,KC DO L=2,LA @@ -1642,7 +1634,7 @@ C ENDIF IF(TIMEDAY.GE.SNAPSHOTHYD) THEN ! WRITE(*,*)'WRITE================',N,TIMEDAY,TIMEDAY*1440. - CALL RESTOUT(-21) +! CALL RESTOUT(-21) IHYDCNT=IHYDCNT+1 SNAPSHOTHYD=FLOAT(ISHYD*IHYDCNT)*60./86400.+TBEGIN ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index b93454402..e38a8aa75 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -694,14 +694,8 @@ C ** ADVANCE INTERNAL VARIABLES C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) - !print*, lf, ll, omp_get_thread_num(), omp_get_num_threads() -c DO K=1,KC - DO L=LF,LL + DO L=2,LA UHDY2(L,K)=UHDY1(L,K) UHDY1(L,K)=UHDY(L,K) VHDX2(L,K)=VHDX1(L,K) @@ -714,8 +708,6 @@ c W1(L,K)=W(L,K) ENDDO ENDDO -c - enddo C C**********************************************************************C C @@ -751,52 +743,34 @@ C----------------------------------------------------------------------C C ! *** PMC BYPASS IF NOT SIMULATING SEDIMENTS IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,SEDBT0,SNDBT0,SEDT0,SNDT0) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c DO K=1,KB - DO L=LF,LL + DO L=1,LC SEDBT(L,K)=0. SNDBT(L,K)=0. ENDDO ENDDO DO K=1,KC - DO L=LF,LL + DO L=1,LC SEDT(L,K)=0. SNDT(L,K)=0. ENDDO ENDDO C DO NS=1,NSED - DO K=1,KB - DO L=LF,LL - SEDBT(L,K)=SEDBT(L,K)+SEDB(L,K,NS) - ENDDO - ENDDO DO K=1,KC - DO L=LF,LL + DO L=1,LC SEDT(L,K)=SEDT(L,K)+SED(L,K,NS) ENDDO ENDDO ENDDO C DO NS=1,NSND - DO K=1,KB - DO L=LF,LL - SNDBT(L,K)=SNDBT(L,K)+SNDB(L,K,NS) - ENDDO - ENDDO DO K=1,KC - DO L=LF,LL + DO L=1,LC SNDT(L,K)=SNDT(L,K)+SND(L,K,NS) ENDDO ENDDO ENDDO - -c - enddo ENDIF C C----------------------------------------------------------------------C @@ -1184,29 +1158,14 @@ C C ** UPDATE BUOYANCY AND CALCULATE NEW BUOYANCY USING C ** AN EQUATION OF STATE C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA B1(L,K)=B(L,K) ENDDO ENDDO -c - enddo C IF(BSC.GT.1.E-6)THEN -c t01=rtc() -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - CALL CALBUOY(LF,LL) -c - enddo + CALL CALBUOY ELSE DO K=1,KC DO L=2,LA @@ -1227,13 +1186,9 @@ C ** CALCULATE U AT V AND V AT U AT TIME LEVEL (N+1) C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,LNW,LSE,LSW) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + STIME=MPI_TIC() !!### WT_NLEVEL +C + DO L=2,LA LN=LNC(L) LS=LSC(L) LNW=LNWC(L) @@ -1246,8 +1201,6 @@ c VU(L)=0.25*(HP(L-1)*(V(LNW,1)+V(L-1,1)) & +HP(L)*(V(LN,1)+V(L,1)))*HUI(L) ENDDO -c - enddo C C**********************************************************************C C @@ -1263,19 +1216,13 @@ C T1TMP=SECNDS(0.0) C CALL CALTBXY(ISTL,IS2TL) -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL +C + DO L=2,LA TBX(L)=(AVCON1*HUI(L)+STBX(L)*SQRT(VU(L)*VU(L) & +U(L,1)*U(L,1)))*U(L,1) TBY(L)=(AVCON1*HVI(L)+STBY(L)*SQRT(UV(L)*UV(L) & +V(L,1)*V(L,1)))*V(L,1) ENDDO -c - enddo C C**********************************************************************C C @@ -1312,6 +1259,7 @@ C C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED AT (N+1) C C----------------------------------------------------------------------C +C C IF(ISWAVE.EQ.0)THEN C @@ -1319,19 +1267,14 @@ C----------------------------------------------------------------------c C IF(ISCORTBC.EQ.0) THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& TMP) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA TVAR3S(L)=TSY(LNC(L)) TVAR3W(L)=TSX(L+1) TVAR3E(L)=TBX(L+1 ) TVAR3N(L)=TBY(LNC(L)) -c ENDDO + ENDDO C + DO L=2 ,LA ! { GEOSR (IBM request) IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. @@ -1352,8 +1295,6 @@ C QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC ENDDO -c - enddo C ENDIF C @@ -1834,18 +1775,11 @@ C C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=1,LC TVAR1S(L,K)=TOX(L,K,1) ENDDO ENDDO -c - enddo C IPLTTMP=0 IF(ISSPH(1).EQ.1.OR.ISSPH(1).EQ.2)IPLTTMP=1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index 402638596..83e012545 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -74,7 +74,7 @@ C NPTXLDS=FLOAT(NINT(TLOADTX*86400.)) ! LOADING START TIME [SEC] NPTXLDE=NPTXLDS+FLOAT(NINT(FLOAT(ITXPRD)*60.)) ! LOADING END TIME [SEC] TXMASS2=TXMASS/(FLOAT(ITXPRD)*60.) ! RELEASED MASS/TIME [KG/SEC] - TXVOL=0.000001 ! LOADING VOL/SEC [M3/SEC] + TXVOL=0.001 ! LOADING VOL/SEC [M3/SEC] TXLDC=TXMASS2/TXVOL ! CONC. FOR TXSER.INP [MG/L] TBEGIN1=SDAY diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for index a1052f586..621fcaff0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for @@ -120,7 +120,7 @@ C IF(ISCO(6).EQ.1)THEN DO NS=1,NSED WRITE(99,907)(SEDB(L,K,NS),K=1,KB) - WRITE(99,907)(SED1(L,K,NS),K=1,KC) + WRITE(99,907)(SED(L,K,NS),K=1,KC) WRITE(99,907)(SEDB1(L,K,NS),K=1,KB) WRITE(99,907)(SED1(L,K,NS),K=1,KC) ENDDO From c6c040b05c61641e66a40d5d4ffc7612df608d5a Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 12 Dec 2022 13:59:14 +0100 Subject: [PATCH 02/77] fixup: Remove OMP loops in additional files Considers files: - CALAVBOLD.for - CALEXP2T0.for - CALPUV2C.for --- .../original_efdc_files/CALAVBOLD.for | 45 +--- .../original_efdc_files/CALEXP2T0.for | 107 ++------- .../original_efdc_files/CALPUV2C.for | 203 ++++-------------- 3 files changed, 63 insertions(+), 292 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for index 30776de2f..ca32d4838 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD.for @@ -14,7 +14,6 @@ C REAL::QQIMAX,RIQMIN,RIQMAX,RIQ REAL::SFAV,SFAB,ABTMP,AVTMP INTEGER::K,L,LS,ISTL_ - INTEGER::LF,LL,ithds C SMTOP2 = 7.8464 C SMBOT1 = 34.6764 C SMBOT2 = 6.1272 @@ -32,21 +31,14 @@ C RIQMIN=-0.023 RIQMAX=0.28 IF(IDRYTBP.NE.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO K=1,KC - DO L=LF,LL + DO K=1,KC + DO L=1,LC IF(IMASKDRY(L).EQ.1)THEN AV(L,K)=AVO*HPI(L) AB(L,K)=ABO*HPI(L) ENDIF ENDDO ENDDO -c - enddo ENDIF IF(ISFAVB.EQ.0)THEN DO K=1,KS @@ -83,14 +75,8 @@ C ENDIF IF(ISFAVB.EQ.1)THEN IF(IDRYTBP.EQ.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL,RIQ,SFAV,SFAB,ABTMP,AVTMP) -!$OMP& REDUCTION(max:AVMAX,ABMAX) REDUCTION(min:AVMIN,ABMIN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KS - DO L=LF,LL + DO K=1,KS + DO L=2,LA QQI(L)=1./QQ(L,K) QQI(L)=MIN(QQI(L),QQIMAX) RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) @@ -115,24 +101,15 @@ C ENDDO ENDDO c - enddo - ELSE - -!$OMP PARALLEL DO PRIVATE(LF,LL,RIQ,SFAV,SFAB,ABTMP,AVTMP) -!$OMP& REDUCTION(max:AVMAX,ABMAX) REDUCTION(min:AVMIN,ABMIN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO K=1,KS - DO L=LF,LL + DO K=1,KS + DO L=2,LA IF(LMASKDRY(L))THEN QQI(L)=1./QQ(L,K) QQI(L)=MIN(QQI(L),QQIMAX) ENDIF -c ENDDO -c DO L=LF,LL + ENDDO + DO L=2,LA IF(LMASKDRY(L))THEN RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) & *(B(L,K+1)-B(L,K))*QQI(L) @@ -156,10 +133,8 @@ C ENDIF ENDDO ENDDO -c - enddo - ENDIF - ENDIF + ENDIF + ENDIF IF(ISFAVB.EQ.2)THEN DO K=1,KS DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for index b7093daba..daad3925a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for @@ -91,33 +91,19 @@ C ** INITIALIZE EXTERNAL CORIOLIS-CURVATURE AND ADVECTIVE FLUX TERMS C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC FCAXE(L)=0. FCAYE(L)=0. FXE(L)=0. FYE(L)=0. ENDDO -c - enddo C C C----------------------------------------------------------------------C C IF(IS2LMC.NE.1)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,UHC,UHB,VHC,VHB, -!$OMP& WU,WV) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) @@ -173,21 +159,10 @@ c DO K=1,KS ENDDO ENDIF ENDDO - enddo C ELSE !IF(IS2LMC.EQ.1)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,UHC1,UHB1,VHC1,VHB1,UHC2,UHB2,VHC2,VHB2, -!$OMP& UHB1MX,UHB1MN,VHC1MX,VHC1MN,UHC1MX,UHC1MN,VHB1MX,VHB1MN, -!$OMP& UHB2MX,UHB2MN,VHC2MX,VHC2MN,UHC2MX,UHC2MN,VHB2MX,VHB2MN, -!$OMP& BOTT, -!$OMP& WU,WV) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) UHC1=0.5*(UHDY(L,1)+UHDY(LS,1)) @@ -309,8 +284,6 @@ c ENDDO ENDDO -c - enddo ENDIF c t03=rtc()-t02 c write(6,*) 'Timing 1----->',t03*1.e3,nthds,IS2LMC @@ -375,14 +348,8 @@ C----------------------------------------------------------------------C C C *** COMPUTE VERTICAL ACCELERATIONS C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LS,WU,WV) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c c DO K=1,KS -c DO L=LF,LL +c DO L=2,LA c LS=LSC(L) c WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) c WV=0.5*DXYV(L)*(W(L,K)+W(LS,K)) @@ -401,14 +368,12 @@ C ** BLOCK MOMENTUM FLUX ON LAND SIDE OF TRIANGULAR CELLS C IF(ITRICELL.GT.0)THEN DO K=1,KC - DO L=LF,LL + DO L=2,LA FUHU(L,K)=STCUV(L)*FUHU(L,K) FVHV(L,K)=STCUV(L)*FVHV(L,K) ENDDO ENDDO ENDIF -c - enddo C c t03=rtc()-t02 c write(6,*) 'Timing 3----->',t03*1.e3,nthds @@ -424,14 +389,8 @@ C IF(ISDCCA.EQ.0)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) -!$OMP& REDUCTION(+:CACSUM) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LN=LNC(L) CAC(L,K)=( FCORC(L)*DXYP(L) & +0.5*SNLT*(V(LN,K)+V(L,K))*DYDI(L) @@ -439,12 +398,10 @@ c ENDDO ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA CACSUM=CACSUM+CAC(L,K) ENDDO ENDDO -c - enddo c t03=rtc()-t02 c write(6,*) 'Timing 40---->',t03*1.e3,nthds C @@ -507,14 +464,8 @@ C ** STANDARD CALCULATION C IF(IS2LMC.EQ.0.AND.CACSUM.GT.1.E-7)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS,LNW,LSE) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) LNW=LNWC(L) @@ -525,7 +476,6 @@ c & +CAC(LS,K)*(U(LSE,K)+U(LS,K))) ENDDO ENDDO - enddo c t03=rtc()-t02 c write(6,*) 'Timing 6----->',t03*1.e3,nthds C @@ -620,14 +570,8 @@ c write(6,*) 'Timing 8----->',t03*1.e3,nthds C C----------------------------------------------------------------------C C -!$OMP PARALLEL DO PRIVATE(LF,LL, -!$OMP& LN,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KC - DO L=LF,LL + DO L=2,LA LN=LNC(L) LS=LSC(L) !HRUO(L)=SUBO(L)*DYU(L)*DXIU(L) @@ -638,8 +582,6 @@ c & +FVHJ(L,K) ) ENDDO ENDDO -c - enddo c t03=rtc()-t02 c write(6,*) 'Timing 9----->',t03*1.e3,nthds @@ -891,11 +833,6 @@ C----------------------------------------------------------------------C c t03=rtc()-t02 c write(6,*) 'Timing 12---->',t03*1.e3,nthds C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(KC.GT.1)THEN C C**********************************************************************C @@ -905,7 +842,7 @@ C C----------------------------------------------------------------------C C DO K=1,KC - DO L=LF,LL + DO L=2,LA FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) FXE(L)=FXE(L)+FX(L,K)*DZC(K) @@ -934,7 +871,7 @@ C IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN C DO K=1,KC - DO L=LF,LL + DO L=2,LA QMCSOURX(L,K)=0. QMCSOURY(L,K)=0. QMCSINKX(L,K)=0. @@ -942,8 +879,6 @@ C ENDDO ENDDO ENDIF -c - enddo C c t03=rtc()-t02 c write(6,*) 'Timing 13---->',t03*1.e3,nthds @@ -1112,13 +1047,8 @@ C IF(IINTPG.EQ.0)THEN C -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c DO K=1,KS - DO L=LF,LL + DO L=2,LA LS=LSC(L) FBBX(L,K)=SBX(L)*GP*HU(L)* & ( HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) @@ -1132,8 +1062,6 @@ c & (BELV(L)-BELV(LS)+Z(K)*(HP(L)-HP(LS))) ) ENDDO ENDDO -c - enddo C ENDIF C @@ -1281,15 +1209,10 @@ C DU(L,KC)=0.0 DV(L,KC)=0.0 ENDIF -!$OMP PARALLEL DO PRIVATE(LF,LL,RCDZF) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c IF(KC.GT.1)THEN DO K=1,KS RCDZF=CDZF(K) - DO L=LF,LL + DO L=2,LA !DXYIU(L)=1./(DXU(L)*DYU(L)) DU(L,K)=RCDZF*( HU(L)*(U(L,K+1)-U(L,K))*DELTI & +DXYIU(L)*(FCAX(L,K+1)-FCAX(L,K)+FBBX(L,K) @@ -1304,13 +1227,11 @@ C C IF(ISTL.EQ.2)THEN C IF(NWSER.GT.0)THEN - DO L=LF,LL + DO L=2,LA DU(L,KS)=DU(L,KS)-CDZU(KS)*TSX(L) DV(L,KS)=DV(L,KS)-CDZU(KS)*TSY(L) ENDDO ENDIF -c - enddo c t03=rtc()-t02 c write(6,*) 'Timing 4----->',t03*1.e3,nthds C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for index 25beb6e30..232403bfa 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for @@ -100,19 +100,14 @@ C NCORDRY=0 ICORDRY=0 NEWDRY=0 -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse_LC(1,ithds) - LL=jse_LC(2,ithds) -c - DO L=LF,LL + DO L=1,LC IQDRYDWN(L)=0 ISCDRY(L)=0 + ENDDO + DO L=1,LC SUB1(L)=SUB(L) SVB1(L)=SVB(L) ENDDO -c - enddo C C ** INITIALIZE SUBGRID SCALE CHANNEL INTERACTIONS C @@ -126,28 +121,16 @@ C C ** CALCULATE EXTERNAL BUOYANCY INTEGRALS AT TIME LEVEL (N) C IF(BSC.GT.1.E-6)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - CALL CALEBI0(LF,LL) -c - enddo - ENDIF + CALL CALEBI C ! *** CALCULATE EXPLICIT EXTERNAL PRESSURE GRADIENTS -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - IF(BSC.GT.1.E-6)THEN - DO L=LF,LL + DO L=2,LA !SBX(L)=0.5*SUB(L)*DYU(L) FPGXE(L)=-SBX(L)*HU(L)*GP*((BI2(L)+BI2(L-1))*(HP(L)-HP(L-1)) & +2.0*HU(L)*(BI1(L)-BI1(L-1)) & +(BE(L)+BE(L-1))*(BELV(L)-BELV(L-1))) + ENDDO + DO L=2,LA LS=LSC(L) !SBY(L)=0.5*SVB(L)*DXV(L) FPGYE(L)=-SBY(L)*HV(L)*GP*((BI2(L)+BI2(LS))*(HP(L)-HP(LS)) @@ -155,19 +138,15 @@ c & +(BE(L)+BE(LS))*(BELV(L)-BELV(LS))) ENDDO ENDIF -c -c enddo C C ** CALCULATE EXPLICIT EXTERNAL UHDYE AND VHDXE EQUATION TERMS C ** HRU=SUB*HMU*DYU/DXU & HRV=SVB*HMV*DXV/DYV C -c!$OMP PARALLEL DO PRIVATE(LF,LL,LS) -c do ithds=0,nthds-1 -c LF=jse(1,ithds) -c LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA H2P(L)=HP(L) ! *** DSLLC SINGLE LINE + ENDDO +C + DO L=2,LA LS=LSC(L) !DXYU(L)=DXU(L)*DYU(L) !DXIU(L)=1./DXU(L) @@ -185,8 +164,6 @@ C & +SVB(L)*DELT*DYIV(L)*(DXYV(L)*(TSY(L)-RITB1*TBY(L)) & -FCAYE(L)+FPGYE(L)-SNLT*FYE(L)) ENDDO -c - enddo IF(ISDSOLV.GE.1.AND.DEBUG)THEN OPEN(1,FILE='FUV.OUT',POSITION='APPEND',STATUS='UNKNOWN') WRITE(1,1001)N,ISTL @@ -217,19 +194,12 @@ c C C ** SET IMPLICIT BOTTOM AND VEGETATION DRAG AS APPROPRIATE C - RCX(1)=0. - RCY(1)=0. -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA RCX(L)=1. RCY(L)=1. ENDDO -c - enddo + RCX(1)=0. + RCY(1)=0. RCX(LC)=0. RCY(LC)=0. C @@ -276,12 +246,7 @@ C C C ** RESET BOUNDARY CONDITIONS SWITCHES C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA SUB(L)=SUBO(L) SVB(L)=SVBO(L) SBX(L)=SBXO(L) @@ -289,8 +254,6 @@ c c SUB(L+1)=SUBO(L+1) c SBX(L+1)=SBXO(L+1) ENDDO -c - enddo SUB(LC)=SUBO(LC) SBX(LC)=SBXO(LC) SVB(1)=SVBO(1) @@ -306,12 +269,7 @@ C C ** ADJUST VOLUME SOURCE AND SINKS C IF(ISGWIE.EQ.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IF(QSUME(L).LE.0.)THEN IF(H1P(L).LE.HDRY)THEN QSUMTMP(L)=0. @@ -326,12 +284,10 @@ c QSUME(L)=QSUMTMP(L) ENDDO DO K=1,KC - DO L=LF,LL + DO L=2,LA QSUM(L,K)=QSUM(L,K)-DIFQVOL(L)*DZC(K) ENDDO ENDDO -c - enddo ENDIF C C ** ADJUST SOURCES AND SINKS ESTIMATING SURFACE AND GROUNDWATER @@ -410,12 +366,7 @@ C C C ** ADVANCE EXTERNAL VARIABLES C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA UHDY1E(L)=UHDYE(L) VHDX1E(L)=VHDXE(L) P1(L)=P(L) @@ -428,7 +379,7 @@ C PMC H2P(L)=H1P(L) ENDDO C IF(ISGWIE.GE.1)THEN - DO L=LF,LL + DO L=2,LA AGWELV2(L)=AGWELV1(L) AGWELV1(L)=AGWELV(L) ENDDO @@ -439,13 +390,11 @@ C ** HRU=HMU*DYU/DXU & HRV=HMV*DXV/DYV C ** DXYIP=1/(DXP*DYP) C C *** DSLLC BEGIN BLOCK - DO L=LF,LL + DO L=2,LA LN=LNC(L) FP1(L)=DELTI*DXYP(L)*P(L)-0.5*G*(UHDYE(L+1)-UHDYE(L) & +VHDXE(LN )-VHDXE(L)) ENDDO -c - enddo C C ** SET NEW TIME LEVEL TERMS IN CONTINUITY EQUATION INCLUDING C ** HOST-GUEST CHANNAL INTERACTION FOR NON BOUNDARY POINTS @@ -454,20 +403,13 @@ C ** INTERACTION C 1000 CONTINUE C1=0.5*G -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA LN=LNC(L) ! *** THE SUB & SVB SWITCHES ALREADY ACCOUNTED FOR FP(L)=FP1(L)-C1*(FUHDYE(L+1)-FUHDYE(L) & +FVHDXE(LN )-FVHDXE(L) & -2.0*QSUME(L) ) ENDDO -c - enddo C IF(ISGWIE.GE.1)THEN DO L=2,LA @@ -476,36 +418,24 @@ C ENDIF C C1=-0.5*DELTD2*G -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA CS(L)=C1*SVB(L )*HRVO(L )*RCY(L )*HV(L ) CW(L)=C1*SUB(L )*HRUO(L )*RCX(L )*HU(L ) CE(L)=C1*SUB(L+1)*HRUO(L+1)*RCX(L+1)*HU(L+1) + ENDDO + DO L=2,LA LN=LNC(L) CN(L)=C1*SVB(LN )*HRVO(LN )*RCY(LN )*HV(LN ) ENDDO -c - enddo C C *** APPLY THE OPEN BOUNDARY CONDITIONS C IF(NBCSOP.GT.0) CALL SETOPENBC(DELT,DELTD2,DELTI,HU,HV) C ! *** SET THE CENTER -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA CC(L)=DELTI*DXYP(L)-CS(L)-CW(L)-CE(L)-CN(L) ENDDO -c - enddo C C ** INSERT IMPLICT SUB-GRID SCALE CHANNEL INTERACTIONS C @@ -514,17 +444,10 @@ C C ! *** SCALE COEFFICIENTS IN EXTERNAL MODEL LINEAR EQUATION SYSTEM CCMNM=1.E+18 -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(min:CCMNM) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA CCMNM=MIN(CCMNM,CC(L)) FPTMP(L)=FP(L) ENDDO -c - enddo CCMNMI=1./CCMNM C @@ -566,12 +489,7 @@ C C ** SCALE BY MINIMUM DIAGONAL C IF(IRVEC.EQ.9)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA CCS(L)=CS(L)*CCMNMI CCW(L)=CW(L)*CCMNMI CCE(L)=CE(L)*CCMNMI @@ -580,8 +498,6 @@ c FPTMP(L)=FPTMP(L)*CCMNMI CCCI(L)=1./CCC(L) ENDDO -c - enddo IF(MDCHH.GE.1)THEN DO NMD=1,MDCHH CCCCHH(NMD)=CCCCHH(NMD)*CCMNMI @@ -677,12 +593,7 @@ C C ** CALCULATE UHEX AND VHEX AND TOTAL DEPTHS AT TIME LEVEL (N+1) C ** HRU=SUB*DYU/DXU & HRV=SVB*DXV/DYV C -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA LS=LSC(L) UHDYE(L)=SUB(L)*( FUHDYE(L) & -DELTD2*HRUO(L)*RCX(L)*HU(L)*(P(L)-P(L-1)) ) @@ -693,8 +604,6 @@ c UHE(L)=UHDYE(L)*DYIU(L) VHE(L)=VHDXE(L)*DXIV(L) ENDDO -c - enddo C C ** CALCULATE NEW SUB-GRID SCALE CHANNEL EXCHANGE FLOWS C @@ -738,19 +647,12 @@ C C ** CALCULATE REVISED CELL DEPTHS BASED ON NEW HORIZONTAL C ** TRANSPORTS AT (N+1) C -!$OMP PARALLEL DO PRIVATE(LF,LL,LN) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA LN=LNC(L) HP(L)=H1P(L)+DELTD2*DXYIP(L)*(2.*QSUME(L) !+QSUM1E(L) PMC & -(UHDYE(L+1)+UHDY1E(L+1)-UHDYE(L)-UHDY1E(L) & +VHDXE(LN) +VHDX1E(LN )-VHDXE(L)-VHDX1E(L))) ENDDO -c - enddo C IF(ISGWIE.GE.1)THEN DO L=2,LA @@ -788,27 +690,17 @@ C C C ** PERFORM INTERMEDIATE UPDATES OF P C -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA P(L)=G*(HP(L)+BELV(L)) ENDDO -c - enddo C C ** CHECK FOR DRYING AND RESOLVE EQUATIONS IF NECESSARY C IF(ISDRY.GT.0.AND.ISDRY.LT.98)THEN ICORDRY=0 -!$OMP PARALLEL DO PRIVATE(LF,LL) REDUCTION(+:ICORDRY) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL-1 + DO L=2,LA + LS=LSC(L) + LN=LNC(L) IF(HP(L).LE.HDRY)THEN IF(ISCDRY(L).EQ.0)THEN ISCDRY(L)=1 @@ -822,11 +714,6 @@ c SBX(L+1)=0. ENDIF ENDDO -c - enddo - do ithds=0,nthds-1 - LL=jse(2,ithds) -c L=LL IF(HP(L).LE.HDRY)THEN IF(ISCDRY(L).EQ.0)THEN @@ -840,8 +727,6 @@ c SUB(L+1)=0. SBX(L+1)=0. ENDIF -c - enddo DO L=2,LA IF(HP(L).LE.HDRY)THEN @@ -1036,38 +921,28 @@ C**********************************************************************C C C ** PERFORM FINAL UPDATES OF P,HU, AND HV C -!$OMP PARALLEL DO PRIVATE(LF,LL,LS) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA P(L)=G*(HP(L)+BELV(L)) + ENDDO + DO L=2,LA LS=LSC(L) HU(L)=0.5*(DXYP(L)*HP(L)+DXYP(L-1)*HP(L-1))*DXYIU(L) HV(L)=0.5*(DXYP(L)*HP(L)+DXYP(LS )*HP(LS ))*DXYIV(L) H1P(L)=H2P(L) ! *** DSLLC, UPDATE THE LAST DEPTH TO ACTUAL PREVIOUS + ENDDO + DO L=2,LA HPI(L)=1./HP(L) HUI(L)=1./HU(L) HVI(L)=1./HV(L) ENDDO -c - enddo C C ** SET TRANSPORT MASK FOR DRY CELLS C IF(ISDRY.GT.0)THEN -!$OMP PARALLEL DO PRIVATE(LF,LL) - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - DO L=LF,LL + DO L=2,LA IMASKDRY(L)=0 LMASKDRY(L)=.TRUE. END DO -c - enddo IF(IDRYTBP.EQ.1)THEN DO L=2,LA LN=LNC(L) From d05dd3b6aba0cff8fc9baf6a04818857ad6a52d6 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 12 Dec 2022 14:42:12 +0100 Subject: [PATCH 03/77] Remove OMP loop around buoyancy initialisation --- .../efdc_fortran_dll/openDA_wrapper/model_init_3.for | 10 +--------- .../efdc_fortran_dll/original_efdc_files/CALBUOY.for | 1 - 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for index 63d284bac..8a71cad5c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for @@ -714,15 +714,7 @@ C C C ** INITIALIZE BUOYANCY AND EQUATION OF STATE C -!$OMP PARALLEL DO PRIVATE(LF,LL) - - do ithds=0,nthds-1 - LF=jse(1,ithds) - LL=jse(2,ithds) -c - CALL CALBUOY(LF,LL) -c - enddo + CALL CALBUOY C C ** INITIALIZE SFL IF(ISRESTI.EQ.0.AND ISTRAN(4).GE.1) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for index 0d7a4aba0..9a778579f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY.for @@ -9,7 +9,6 @@ C IMPLICIT NONE INTEGER::NS,K,L REAL::RHOO,SSTMP,TTMP,RHTMP,PRES,CCON,TMP,TEM0 - INTEGER::LF,LL,ithds C IF(IBSC.EQ.1) GOTO 1000 ISPCOR=0 From 4162d3f235abda91d7530d3a77f3879362b789a8 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 09:10:00 +0100 Subject: [PATCH 04/77] Split lines that are considered too long --- .../native/efdc_fortran_dll/original_efdc_files/s_bedload.f90 | 3 ++- .../native/efdc_fortran_dll/original_efdc_files/s_main.f90 | 3 ++- .../native/efdc_fortran_dll/original_efdc_files/s_morph.f90 | 3 ++- .../native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 | 3 ++- 4 files changed, 8 insertions(+), 4 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_bedload.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_bedload.f90 index ab656ae92..cd1d38f65 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_bedload.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_bedload.f90 @@ -36,7 +36,8 @@ SUBROUTINE BEDLOADJ PSUS(L,1:NSCM)=0.0 ELSEWHERE BLFLAG(L,1:NSCM)=1 - PSUS(L,1:NSCM)=MAX((LOG(USW(L,1:NSCM))-LOG(SQRT(TCRSUS(1:NSCM))/DWS(1:NSCM)))/(LOG(4.0)-LOG(SQRT(TCRSUS(1:NSCM))/DWS(1:NSCM))),0.D0) + PSUS(L,1:NSCM)=MAX((LOG(USW(L,1:NSCM))-LOG(SQRT(TCRSUS(1:NSCM))/DWS(1:NSCM)))& + /(LOG(4.0)-LOG(SQRT(TCRSUS(1:NSCM))/DWS(1:NSCM))),0.0) ENDWHERE ELSEWHERE BLFLAG(L,1:NSCM)=0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 index 338ed0e71..3a00e0475 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 @@ -342,7 +342,8 @@ SUBROUTINE SEDZLJ_MAIN ! the flux into the water column. ! QSBDTOP(L)=SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM)) - QWBDTOP(L)=VDRBED(L,KBT(L))*SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)>0.0)+SUM(SSGI(1:NSCM)*VDRDEPO(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)<0.0) + QWBDTOP(L)=VDRBED(L,KBT(L))*SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)>0.0) & + +SUM(SSGI(1:NSCM)*VDRDEPO(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)<0.0) !DO NS=1,NSCM !QWBDTOP(L)=QWBDTOP(L)+SSGI(1:NSCM)*(VDRBED(L,KBT(L))*MAX(SEDF(L,0,NS),0.0)+VDRDEPO(NS)*MIN(SEDF(L,0,NS),0.0)) !ENDDO diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 index 899e3db6f..f7c0be655 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 @@ -37,7 +37,8 @@ SUBROUTINE MORPHJ IF(HP(L)<=0.0) THEN IF(ABS(H1P(L))>=HWET) THEN ITMP=1 - WRITE(8,"('NEG DEPTH DUE TO MORPH CHANGE', 2I5,12F12.5)")IL(L),JL(L),HBED1(L,KBT(L)),HBED(L,KBT(L)),BELV1(L),BELV(L),DELT,QSBDTOP(L),QWBDTOP(L),HBEDA(L) + WRITE(8,"('NEG DEPTH DUE TO MORPH CHANGE', 2I5,12F12.5)")IL(L),JL(L),HBED1(L,KBT(L)),HBED(L,KBT(L)), & + BELV1(L),BELV(L),DELT,QSBDTOP(L),QWBDTOP(L),HBEDA(L) WRITE(8,"('NEG DEPTH DUE TO MORPH CHANGE', 2I5,12F12.5)")L,KBT(L),(HBED(L,K),K=1,KBT(L)) ELSE HP(L)=0.9*HDRY diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 index 4f184965d..7ec0e9671 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 @@ -305,7 +305,8 @@ SUBROUTINE SEDZLJ(L) SN10=(TAUDD(1)-TAU(L))/(TAUDD(1)-TAUDD(2)) !weigthing factor 2 SN01=D50TMPP/NSCTOT !weighting factor 3 SN11=(NSCTOT-D50TMPP)/NSCTOT !weighting factor 4 - ERATEMOD(L)=(SN00*EXP(SN11*LOG(ERATEND(NSC0,NTAU0))+SN01*LOG(ERATEND(NSC1,NTAU0)))+SN10*EXP(SN11*LOG(ERATEND(NSC0,NTAU1))+SN01*LOG(ERATEND(NSC1,NTAU1))))*BULKDENS(LL,L) !log-linear interpolation + ERATEMOD(L)=(SN00*EXP(SN11*LOG(ERATEND(NSC0,NTAU0))+SN01*LOG(ERATEND(NSC1,NTAU0)))+SN10*EXP(SN11*LOG(ERATEND(NSC0,NTAU1)) & + +SN01*LOG(ERATEND(NSC1,NTAU1))))*BULKDENS(LL,L) !log-linear interpolation ENDIF ! Sort out Thicknesses and Erosion Rates From c65b91c4687dd42e57db63bd22c6777c4c73f667 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 09:28:12 +0100 Subject: [PATCH 05/77] Replace write FMT containing bracketed variables This fix resolves the patch applied in OpenDA that comments out these print statements, specifically `CGATEFLX.patch` and `RWQC1.patch`. --- .../original_efdc_files/CGATEFLX.for | 30 ++++---- .../original_efdc_files/CGATEFLX.patch | 74 ------------------- .../original_efdc_files/Makefile | 7 +- .../original_efdc_files/RWQC1.for | 17 +++-- .../original_efdc_files/RWQC1.patch | 27 ------- 5 files changed, 30 insertions(+), 125 deletions(-) delete mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.patch delete mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.patch diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for index f0794c37d..ad5770c93 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for @@ -28,6 +28,7 @@ C REAL GQT(NQCTLM),LUA(NQCTLM),LDA(NQCTLM) REAL CG10 REAL CQ(LCM),CV(LCM) ! GEOSR UNG 2014.11.12 Warning message writing + CHARACTER*256 FMTSTR CHARACTER*80 CTLE1 ! open time control : jgcho 2010.8.17 temporary ! IF (N.EQ.1) GATEOTM=1.0 @@ -64,25 +65,24 @@ C OPEN(711,FILE=TRIM(FSINK),STATUS='UNKNOWN') ! OPEN OLD FILE CLOSE(711,STATUS='DELETE') ! DELETE OLD FILE OPEN(711,FILE=FSINK,STATUS='UNKNOWN') ! OPEN NEW FILE - WRITE(711,7101) - 7101 FORMAT(' N TIME ' - & ,('ID HUP HDW DIF Q',<8*(KC-1)+5>X - & ,20X)) + WRITE(FMTSTR, '("( N TIME ,",I0,"(ID HUP HDW + *DIF Q,",I0,"X,20X))" )') NQCTL, 8*(KC-1)+5 CLOSE(711) OPEN(712,FILE='SINKT.OUT',STATUS='UNKNOWN') ! OPEN OLD FILE CLOSE(712,STATUS='DELETE') ! DELETE OLD FILE OPEN(712,FILE='SINKT.OUT',STATUS='UNKNOWN') ! OPEN NEW FILE - WRITE(712,7102) ' N TIME',(NS,NS=1,NQCTL) - 7102 FORMAT(A,I8) + WRITE(FMTSTR, '("(A,",I0,"I8)")') NQCTL + WRITE(712,FMTSTR) ' N TIME',(NS,NS=1,NQCTL) ! GEOSR GATE: SINK2 OPEN(713,FILE='SINK2.OUT',STATUS='UNKNOWN') ! OPEN OLD FILE CLOSE(713,STATUS='DELETE') ! DELETE OLD FILE OPEN(713,FILE='SINK2.OUT',STATUS='UNKNOWN') ! OPEN NEW FILE - write(713,7103) ' N TIME', + write(FMTSTR, '("(A,",I0,"(3x,i2.2,a,i2.2))")') 1000 + write(713,FMTSTR) ' N TIME', & ((NS,'_K',k,k=1,KC),NS,'_O',00,NS=1,NQCTL) - 7103 FORMAT(A,<1000>(3x,i2.2,a,i2.2)) +!} GEOSR GATE : jgcho 2016.07.14 ISINK=2 ! READY TO WRITE SINK##.OUT @@ -1448,10 +1448,12 @@ C C FSINK='SINK.OUT' OPEN(711,FILE=TRIM(FSINK),POSITION='APPEND') - WRITE(711,7110) N,TIMEDAY,(IGCHECK(NS),HUPG(NS),HDWG(NS) + WRITE(FMTSTR, + & '("(I8,F10.4,",I0,"(I4,3F8.2,",I0,"F8.2,F20.1))")') + & NQCTL, KC + WRITE(711,FMTSTR) N,TIMEDAY,(IGCHECK(NS),HUPG(NS),HDWG(NS) & ,DELHG(NS),(QCTLT(K,NS),K=1,KC),GGQSUM(NS) & ,NS=1,NQCTL) !,(GGQSUM(NS),NS=1,NQCTL) - 7110 FORMAT(I8,F10.4,(I4,3F8.2,F8.2,F20.1)) CLOSE(711) C OPEN(712,FILE='SINKT.OUT',POSITION='APPEND') ! OPEN NEW FILE @@ -1460,15 +1462,15 @@ C GQT(NS)=GQT(NS)+QCTLT(K,NS) ENDDO ENDDO - WRITE(712,7120) N,TIMEDAY,(GQT(NS),NS=1,NQCTL) - 7120 FORMAT(I8,F10.4,F8.2) + WRITE(FMTSTR, '("(I8,F10.4,",I0,"F8.2)")') NQCTL + WRITE(712,FMTSTR) N,TIMEDAY,(GQT(NS),NS=1,NQCTL) ! GEOSR GATE: write sink2.out OPEN(713,FILE='SINK2.OUT',POSITION='APPEND') - WRITE(713,7130) N,TIMEDAY,((QCTLT(K,NS),K=1,KC-1) + WRITE(FMTSTR, '("(I8,F10.5,",I0,"(",I0,"F9.2))")') NQCTL, KC+1 + WRITE(713,FMTSTR) N,TIMEDAY,((QCTLT(K,NS),K=1,KC-1) & ,QCTLT(KC,NS)-DUMPG2(NS),DUMPG2(NS) & ,NS=1,NQCTL) - 7130 FORMAT(I8,F10.5,(F9.2)) CLOSE(713) ENDIF ! IF (MOD(FLOAT(N),SNKW).EQ.0.) THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.patch b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.patch deleted file mode 100644 index 068ceb834..000000000 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.patch +++ /dev/null @@ -1,74 +0,0 @@ ---- model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for (revision 682) -+++ model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for (working copy) -@@ -46,25 +46,25 @@ - OPEN(711,FILE=TRIM(FSINK),STATUS='UNKNOWN') ! OPEN OLD FILE - CLOSE(711,STATUS='DELETE') ! DELETE OLD FILE - OPEN(711,FILE=FSINK,STATUS='UNKNOWN') ! OPEN NEW FILE -- WRITE(711,7101) -- 7101 FORMAT(' N TIME ' -- & ,('ID HUP HDW DIF Q',<8*(KC-1)+5>X -- & ,20X)) -+c WRITE(711,7101) -+c 7101 FORMAT(' N TIME ' -+c & ,('ID HUP HDW DIF Q',<8*(KC-1)+5>X -+c & ,20X)) - CLOSE(711) - - OPEN(712,FILE='SINKT.OUT',STATUS='UNKNOWN') ! OPEN OLD FILE - CLOSE(712,STATUS='DELETE') ! DELETE OLD FILE - OPEN(712,FILE='SINKT.OUT',STATUS='UNKNOWN') ! OPEN NEW FILE -- WRITE(712,7102) ' N TIME',(NS,NS=1,NQCTL) -- 7102 FORMAT(A,I8) -+c WRITE(712,7102) ' N TIME',(NS,NS=1,NQCTL) -+c 7102 FORMAT(A,I8) - - ! GEOSR GATE: SINK2 - OPEN(713,FILE='SINK2.OUT',STATUS='UNKNOWN') ! OPEN OLD FILE - CLOSE(713,STATUS='DELETE') ! DELETE OLD FILE - OPEN(713,FILE='SINK2.OUT',STATUS='UNKNOWN') ! OPEN NEW FILE -- write(713,7103) ' N TIME', -- & ((NS,'_K',k,k=1,KC),NS,'_O',00,NS=1,NQCTL) -- 7103 FORMAT(A,<1000>(3x,i2.2,a,i2.2)) -+c write(713,7103) ' N TIME', -+c & ((NS,'_K',k,k=1,KC),NS,'_O',00,NS=1,NQCTL) -+c 7103 FORMAT(A,<1000>(3x,i2.2,a,i2.2)) - - - ISINK=2 ! READY TO WRITE SINK##.OUT -@@ -1432,10 +1432,10 @@ - C - FSINK='SINK.OUT' - OPEN(711,FILE=TRIM(FSINK),POSITION='APPEND') -- WRITE(711,7110) N,TIMEDAY,(IGCHECK(NS),HUPG(NS),HDWG(NS) -- & ,DELHG(NS),(QCTLT(K,NS),K=1,KC),GGQSUM(NS) -- & ,NS=1,NQCTL) !,(GGQSUM(NS),NS=1,NQCTL) -- 7110 FORMAT(I8,F10.4,(I4,3F8.2,F8.2,F20.1)) -+c WRITE(711,7110) N,TIMEDAY,(IGCHECK(NS),HUPG(NS),HDWG(NS) -+c & ,DELHG(NS),(QCTLT(K,NS),K=1,KC),GGQSUM(NS) -+c & ,NS=1,NQCTL) !,(GGQSUM(NS),NS=1,NQCTL) -+c 7110 FORMAT(I8,F10.4,(I4,3F8.2,F8.2,F20.1)) - CLOSE(711) - C - OPEN(712,FILE='SINKT.OUT',POSITION='APPEND') ! OPEN NEW FILE -@@ -1444,15 +1444,15 @@ - GQT(NS)=GQT(NS)+QCTLT(K,NS) - ENDDO - ENDDO -- WRITE(712,7120) N,TIMEDAY,(GQT(NS),NS=1,NQCTL) -- 7120 FORMAT(I8,F10.4,F8.2) -+c WRITE(712,7120) N,TIMEDAY,(GQT(NS),NS=1,NQCTL) -+c 7120 FORMAT(I8,F10.4,F8.2) - - ! GEOSR GATE: write sink2.out - OPEN(713,FILE='SINK2.OUT',POSITION='APPEND') -- WRITE(713,7130) N,TIMEDAY,((QCTLT(K,NS),K=1,KC-1) -- & ,QCTLT(KC,NS)-DUMPG2(NS),DUMPG2(NS) -- & ,NS=1,NQCTL) -- 7130 FORMAT(I8,F10.5,(F9.2)) -+c WRITE(713,7130) N,TIMEDAY,((QCTLT(K,NS),K=1,KC-1) -+c & ,QCTLT(KC,NS)-DUMPG2(NS),DUMPG2(NS) -+c & ,NS=1,NQCTL) -+c 7130 FORMAT(I8,F10.5,(F9.2)) - CLOSE(713) - - ENDIF ! IF (MOD(FLOAT(N),SNKW).EQ.0.) THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile index 2ab92ac73..9bfa728e1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile @@ -36,9 +36,8 @@ MAKE_FFLAGS = \ #FFLAGS = -ffixed-line-length-none -ffree-line-length-none -fPIC -POBJECTS = CGATEFLX.po RWQC1.po - OBJECTS = \ +CGATEFLX.o RWQC1.o \ ACON.o CALEXP.o CALTSXY.o READWIMS1.o WQSKE4.o GATECTLREAD.o SCANEFDC.o \ VELPLTH.o DRIFTER.o SURFPLT.o WINDWAVE.o s_sedzlj.o EEXPOUT.o RESTOUT.o \ WQ3D.o s_shear.o CALHEAT.o CALPUVTT.o VARZEROReal.o \ @@ -94,9 +93,9 @@ openmp: MAKE_FFLAGS += $(F_OPENMP) openmp: MAKE_SO += $(F_OPENMP) openmp: libEfdcOrig.a -libEfdcOrig.a: $(POBJECTS) $(OBJECTS) $(COMPAT_OBJS) +libEfdcOrig.a: $(OBJECTS) $(COMPAT_OBJS) rm -f $@ - ar cq $@ $(POBJECTS) $(OBJECTS) $(COMPAT_OBJS) + ar cq $@ $(OBJECTS) $(COMPAT_OBJS) install: diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index 351d0f673..7377c9140 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -12,6 +12,7 @@ C C PARAMETER (CONV1=1.0E3,CONV2=8.64E4) PMC Single Line CHARACTER TITLE(5)*79, CCMRM*1 CHARACTER LINE*255 + CHARACTER FMTSTR*80 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XDSL REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XPSL REAL WQTDTEMP(1000),CONV1,CONV2,WQDIUDT,XC,XP,XPC,XPD,XPG @@ -2205,16 +2206,19 @@ C INITIALIZE write(1,'(a,a)') 'VERTICAL VELOCITY, ALGAL-DENSITY,' & ,' SOLAR RADIATION, chl-a PRINT AT EACH LAYER' write(1,'(a,i4,a,i4)') 'I=',iww(i),' J=',jww(i) - write(1,7111) ' tm' - & ,((('vel_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) - & ,((('den_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) - & ,((('sol_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) - & ,(('chl_',k),k=KC,1,-1) + write(FMTSTR, + & '("(a, 3(",I0,"(",I0,"(3x,a,i2.2,a,i2.2))),",I0,"(6x,a,i2.2))")') + & KC, NXSP, KC + write(1,FMTSTR) ' tm' + & ,(('vel_',nsp,'_',k,nsp=1,NXSP),k=KC,1,-1) + & ,(('den_',nsp,'_',k,nsp=1,NXSP),k=KC,1,-1) + & ,(('sol_',nsp,'_',k,nsp=1,NXSP),k=KC,1,-1) + & ,('chl_',k,k=KC,1,-1) CLOSE(1) enddo ENDIF ENDIF - 7111 format(a, 3(((3x,a,i2.2,a,i2.2))),(6x,a,i2.2) ) + !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 if (IWQDGSTOX.eq.1) then PRINT *,'WQ: READING WQDGSTOX.INP - DG Salt TOX Control' @@ -2252,6 +2256,7 @@ C INITIALIZE CLOSE(1) endif !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + DO I=1,IWQZ IWQKA(I)=IWQKA(1) WQKRO(I)=WQKRO(1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.patch b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.patch deleted file mode 100644 index 952fce85a..000000000 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.patch +++ /dev/null @@ -1,27 +0,0 @@ -diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for -index 1fbad036b..3e8b24c1e 100644 ---- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for -+++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for -@@ -2205,16 +2205,16 @@ C INITIALIZE - write(1,'(a,a)') 'VERTICAL VELOCITY, ALGAL-DENSITY,' - & ,' SOLAR RADIATION, chl-a PRINT AT EACH LAYER' - write(1,'(a,i4,a,i4)') 'I=',iww(i),' J=',jww(i) -- write(1,7111) ' tm' -- & ,((('vel_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -- & ,((('den_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -- & ,((('sol_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -- & ,(('chl_',k),k=KC,1,-1) -+c write(1,7111) ' tm' -+c & ,((('vel_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -+c & ,((('den_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -+c & ,((('sol_',nsp,'_',k),nsp=1,NXSP),k=KC,1,-1) -+c & ,(('chl_',k),k=KC,1,-1) - CLOSE(1) - enddo - ENDIF - ENDIF -- 7111 format(a, 3(((3x,a,i2.2,a,i2.2))),(6x,a,i2.2) ) -+c 7111 format(a, 3(((3x,a,i2.2,a,i2.2))),(6x,a,i2.2) ) - !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 - if (IWQDGSTOX.eq.1) then - IF(MYRANK.EQ.0)THEN From 49fb53b28ca3b5347a481a7c81842f29d81d95e0 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 09:59:43 +0100 Subject: [PATCH 06/77] Replace deprecated `PAUSE` call with `READ` A print is inserted before invoking `READ(*,*)` to notify the user of the suspended state of the application. This is similar to the message emitted by `PAUSE`. The behaviour is now slightly different: - To continue: ENTER should be provided in stead of 'go'; - To terminate: a signal needs to be sent manually. --- .../native/efdc_fortran_dll/original_efdc_files/CALSED.for | 6 ++++-- .../native/efdc_fortran_dll/original_efdc_files/LUDCMP.for | 6 +++++- .../native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for | 4 ++-- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for index ce021ebcd..bdaf45e29 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for @@ -1060,7 +1060,8 @@ C DO L=2,LA IF(SED(L,K,NS).LT.-1.0)THEN WRITE(1,107)TIME,NS,IL(L),JL(L),K,SED(L,K,NS) - PAUSE + PRINT *, "Application suspended. Hit ENTER to continue" + READ(*,*) ENDIF ENDDO ENDDO @@ -1071,7 +1072,8 @@ C IF(SEDB(L,KBT(L),NS).LT.0.)THEN WRITE(1,108)TIME,NS,IL(L),JL(L),KBT(L),SEDB(L,KBT(L),NS), & SEDF(L,0,NS) - PAUSE + PRINT *, "Application suspended. Hit ENTER to continue" + READ(*,*) ENDIF ENDDO ENDDO diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for index 82ceafb4c..5cbc64725 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for @@ -13,7 +13,11 @@ C DO 11 J=1,N IF(ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) 11 CONTINUE - IF(AAMAX.EQ.0.) PAUSE 'SINGULAR MATRIX.' + IF(AAMAX.EQ.0.) THEN + PRINT *, 'SINGULAR MATRIX.' + PRINT *, "Application suspended. Hit ENTER to continue" + READ(*,*) + ENDIF VV(I)=1./AAMAX 12 CONTINUE DO 19 J=1,N diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for index 2e4d5122e..00e1dcb1f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for @@ -56,8 +56,8 @@ C REWIND(1) CCMRM = '#' CALL SKIPCOMM(1, CCMRM) - READ(1, *) IBENZ - WRITE(2, 65) TIMTMP, IBENZ + READ(1, *) IBENZ + WRITE(2, 65) TIMTMP, IBENZ 65 FORMAT(' * BENTHIC FLUXES AT ', F10.5,' DAYS OF MODEL RUN',/, & ' NUMBER OF BENTHIC FLUX ZONES = ', I4) C From 5c02de790c8bc4f2b66e12fa9c6f1aa94b52de86 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 10:11:16 +0100 Subject: [PATCH 07/77] Remove unused variables --- .../original_efdc_files/AINIT.for | 2 +- .../original_efdc_files/BAL2T5.for | 4 ++-- .../original_efdc_files/CALAVB2.for | 4 ++-- .../original_efdc_files/CALBED9.for | 2 +- .../original_efdc_files/CALEBI.for | 7 ++----- .../original_efdc_files/CALFQC.for | 5 ++--- .../original_efdc_files/CALHDMF.for | 4 ++-- .../original_efdc_files/CALPUVTT.for | 9 --------- .../original_efdc_files/CALSND.for | 2 +- .../original_efdc_files/CALTBXY.for | 2 +- .../original_efdc_files/CGATEFLX.for | 1 - .../original_efdc_files/DRIFTER.f90 | 15 +++++++-------- .../efdc_fortran_dll/original_efdc_files/HDMT.for | 1 - .../original_efdc_files/HDMT2T.for | 1 - .../original_efdc_files/INPUT.for | 2 +- .../original_efdc_files/READOIL.for | 6 +++--- .../original_efdc_files/RSALPLTV.for | 2 +- .../original_efdc_files/RWQC1.for | 3 +-- .../original_efdc_files/RWQCSR.for | 4 ++-- .../original_efdc_files/RWQICI.for | 2 +- .../original_efdc_files/TOXCHEM.for | 2 +- .../original_efdc_files/WASP7EPA.for | 1 - .../original_efdc_files/WINDWAVE.f90 | 4 ++-- .../original_efdc_files/WQSKE1.for | 2 +- .../original_efdc_files/s_main.f90 | 2 +- .../original_efdc_files/s_morph.f90 | 2 +- .../original_efdc_files/s_sedic.f90 | 5 ++--- .../original_efdc_files/s_sedzlj.f90 | 4 ++-- .../original_efdc_files/s_shear.f90 | 2 +- .../original_efdc_files/tecplot.f90 | 7 +++---- 30 files changed, 44 insertions(+), 65 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for index ed88afa1b..47edbd09a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for @@ -10,7 +10,7 @@ C ALL ZEROING OF ARRAYS MOVED TO ZERO C USE GLOBAL IMPLICIT NONE - INTEGER::L,I,J,LS,LV,NT,LCHNV,IVAL,NS,K,NMD,LHOST,LCHNU,NV,NX + INTEGER::L,I,J,LS,NT,LCHNV,IVAL,NS,K,NMD,LHOST,LCHNU,NV,NX INTEGER::NTMPC,NTMPN C C ** INITIALIZE ARRAYS diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for index 83de0534c..cd42a364a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for @@ -31,9 +31,9 @@ C REAL::DYEERR2T,UMOERR,VMOERR,ENEERR,RVERDE,REERDE,RVERDO REAL::RVERDO2T,RWVERDO2T,RSERDO,RDERDO,RDERDO2T,RUERDO,REERDO REAL::RDERDE,RUERDE2T,RBVERDE2T,RDERDE2T,RUMERDE,RUMERDO - REAL::RMVERDO,UUEBMO,RVMERDO,VVEBMO,PPEBMO,TMPVAL,BBEBMO,SBLOUT2TT + REAL::UUEBMO,RVMERDO,VVEBMO,PPEBMO,TMPVAL,BBEBMO,SBLOUT2TT REAL::RVERDE2T,RWVERDE2T,RSERDE,RVMERDE,VOLBMO,VMOBMO,ENEBMO - REAL::ENEBEG,ENEEND,ENEOUT,AMOEND,UUEND,VVEEND,PPEEND,BBEEND + REAL::ENEBEG,ENEEND,ENEOUT,AMOEND,VVEEND,PPEEND,BBEEND REAL::UUEEND,VMOEND,SALEND,TIME,VOLEND,VOLEND2T,BVOLEND2T REAL::WVOLEND2T,DYEEND,UMOEND INTEGER::NT,LN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for index 59ef60485..5d007a881 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for @@ -23,9 +23,9 @@ C REAL*8 TMPVAL,TMPVAL1,SBTOP,SVTOP,TMPVAL2,SVTOP2,SVBOT REAL*8 SFAV,SFAB,SBBOT,TMPVAL3 REAL*8 ATURB1,ATURB2,TURBC1 - REAL*8 AVTMP,ABTMP,BBTC,DELBSQ + REAL*8 AVTMP,ABTMP C - REAL*8 TMP1,AQTMP + REAL*8 AQTMP C INTEGER K,L,LS,ISTL_ C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBED9.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBED9.for index 8155be236..b21d5f694 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBED9.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBED9.for @@ -9,7 +9,7 @@ C IMPLICIT NONE INTEGER::K,L,IFLAG,KK,NSB,LUTMP,NS,NX,KBTM1 REAL::TMPVAL,WDENKGM3,WDENGMM3,TMPVALK,TMPVALKP - REAL::BETTMP,VOIDCON1,HDEBTMP,TMPVALO,TMPVALN,TMPEXP,TMPTOP + REAL::BETTMP,VOIDCON1,TMPVALO,TMPVALN,TMPEXP,TMPTOP REAL::TMPBOT,FSTRSE,FDSTRSE,FHYDCN,DSTRESET,HBEDTMP REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SNDHYDCN IF(.NOT.ALLOCATED(SNDHYDCN))THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for index 647b3228a..a36c22363 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for @@ -52,16 +52,13 @@ C ** CALEBI CALCULATES THE EXTERNAL BUOYANCY INTEGRALS C USE GLOBAL IMPLICIT NONE - INTEGER::K,L,IPMC,LLCM - REAL::EPSILON,DBK,DZCBK + INTEGER::K,L,LLCM + REAL::DBK,DZCBK REAL*4 DZCB(KCM) REAL*4 BK(KCM) PARAMETER(LLCM=200) - REAL*4 BI1T(LLCM) - REAL*4 BI2T(LLCM) - REAL*4 BET(LLCM) DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for index fb5b16d32..29edda47c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for @@ -9,9 +9,8 @@ C ** OUTFLOWS; AND EMBEDED CHANNEL INFLOWS AND OUTFLOWS C USE GLOBAL - INTEGER::L,K,LN,LS,ID,JD,KD,NWR,IU,JU,KU,LU,NS,LNW,LSE,LL - INTEGER::LD,NMD,LHOST,LCHNU,LW,LE,NJP - REAL::TMPVAL + INTEGER::L,K,ID,JD,KD,NWR,IU,JU,KU,LU,NS + INTEGER::LD,NMD,NJP DIMENSION CON(LCM,KCM),CON1(LCM,KCM),FQCPAD(0:LCM1,KCM), & QSUMNAD(0:LCM1,KCM),QSUMPAD(0:LCM1,KCM) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for index 27897a708..4e0f4d5d4 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for @@ -12,9 +12,9 @@ C 2008-10 SANG YUK (DSLLC) CORRECTED THE DIFFUSIVE MOMENTUM FLUXES COMPUTAT C USE GLOBAL IMPLICIT NONE - INTEGER::L,LN,LS,LE,LW,K,LL,J,I,ithds,LF ! ithds,LF GEOSR jgcho 151118 + INTEGER::L,LN,LS,LW,K,LL,J,I REAL::SLIPCO,DY2DZBR,DX2DZBR,CSDRAG,SLIPFAC,TMPVAL,DSQR,WVFACT - REAL::DTMPH,DTMPX,AHWVX,SXYLN,SXYEE,PMC + REAL::DTMPH,DTMPX,AHWVX,SXYLN,SXYEE REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::AHEE REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::AHNN REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SXY diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUVTT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUVTT.for index bce5e88d1..e472d2b2d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUVTT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUVTT.for @@ -39,22 +39,13 @@ C HP(L) = PMCTESTX(5,L) C USE GLOBAL DIMENSION QSUMTMP(LCM) - DIMENSION QCHANUT(NCHANM),QCHANVT(NCHANM) PARAMETER (LLCM=200) REAL, SAVE :: CCW1(LLCM),CCE1(LLCM),CCN1(LLCM),CCS1(LLCM) REAL, SAVE :: CCC1(LLCM) - REAL, SAVE :: UHDY1ET(LLCM) - REAL, SAVE :: VHDX1ET(LLCM) - REAL, SAVE :: H1PT(LLCM) - - REAL*8 DTMP REAL*4 EPSILON - LOGICAL HILOWX(LCM) - LOGICAL HILOWY(LCM) - REAL*4 DELTAHP C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for index 12ffb7379..60990084b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for @@ -8,7 +8,7 @@ C IMPLICIT NONE REAL::TIME,GRADSED,SIGP,CRNUM,DUM1,DUM3,DUM4,DIASED3 - REAL::CSDNSET,FSEDMODE,CSNDZEQ,ZEQMIN,CSNDEQC,CSHIELDS,TMPVAL + REAL::FSEDMODE,CSNDZEQ,ZEQMIN,CSNDEQC,CSHIELDS,TMPVAL REAL::CSNDSET,SHIELDS,TOP,BOT,WSFAC,WESE,WESEMX REAL::PROBDEP,WSETMP,WVEL,CLEFT,CRIGHT,SNDBTMP,SEDAVG REAL::AA11,AA12,AA21,AA22,BB11,BB22,DETI,FLUXFAC diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for index 92dc155f1..da2389276 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for @@ -27,7 +27,7 @@ C REAL::FRACLAY,FHLAYC,FHLAYW,FHLAYS,WCHAN,RLCHN,HCHAN,STBXCH REAL::FXVEGCH,STBYCH,FYVEGCH,TMPVALW,WVFACT,QQWCTMP,TWCTMP REAL::AEXTMP,TMPVAL,USTARC,CDRGTMP,TAUBTMP,TAUE,RIPAMP - REAL::TAUBTM,RIPSTP,RIPFAC,ZBRMAX,ZBRMIN,CDRGMAX,ZBREU + REAL::RIPSTP,RIPFAC,ZBRMAX,ZBRMIN,CDRGMAX,ZBREU REAL::CDRGMIN,WVDTMP,RKZTURB,UTMP,VTMP,DWVDZ,DWUDZ,DWVD2Z REAL::DWUD2Z,HZRVDZ,HZRUDZ,ZDHZRV,ZDHZRU,ZBREV,HZREFV,HZREFU REAL::QWDQCV,QWDQCU,QCTMPV,QCTMPU,HOTLYMN,HOTLYMX,CDTMPVY diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for index ad5770c93..2303243f0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for @@ -29,7 +29,6 @@ C REAL CG10 REAL CQ(LCM),CV(LCM) ! GEOSR UNG 2014.11.12 Warning message writing CHARACTER*256 FMTSTR - CHARACTER*80 CTLE1 ! open time control : jgcho 2010.8.17 temporary ! IF (N.EQ.1) GATEOTM=1.0 ! GTIMENOW=TIMEDAY !N*DT/86400. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 index 847350c4e..f39144313 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 @@ -28,8 +28,7 @@ SUBROUTINE DRIFTERC ! ******************************************************** REAL(RKD) ::KDY1,KDY2,KDY3,KDY4 REAL(RKD) ::KDZ1,KDZ2,KDZ3,KDZ4 REAL(RKD) ::U1NP,V1NP,W1NP,U2NP,V2NP,W2NP - REAL(RKD) ::ZSIG - REAL, SAVE::TIMENEXT, PMC + REAL, SAVE::TIMENEXT CHARACTER*80 TITLE,METHOD !{GEOSR, OIL, CWCHO, 101104 @@ -39,7 +38,7 @@ SUBROUTINE DRIFTERC ! ******************************************************** !{GEOSR, 2014.11.25 CWCHO, OIL WIND TRANSFER COEFF. INTEGER(4):: NA, M1, M2, MSAVE - REAL(RKD) ::TIME, TDIFF, TIME_PRE + REAL(RKD) ::TIME, TDIFF REAL(RKD) ::WTM1, WTM2, DEGM1, DEGM2 REAL(RKD) ::WINDS1, WINDS2, WINDE1, WINDE2, WINDN1, WINDN2 REAL(RKD) ::WINDEE, WINDNN, WINDSPD @@ -320,8 +319,8 @@ SUBROUTINE DRIFTERINP ! ****************************************************** !READING INPUT DATA OF INITIAL LOCATIONS OF DRIFTERS !OUTPUT: NPD,XLA,YLA,ZLA,NP=1:NPD ! LA_BEGTI, LA_ENDTI, LA_FREQ,LANDT - INTEGER(4)::NP,I,J,K - REAL(RKD) ::XC(4),YC(4),AREA2,RANVAL + INTEGER(4)::NP + REAL(RKD) ::RANVAL REAL(8),EXTERNAL::DRAND !IT NEEDS THIS STATEMENT IN CASE OF IMPLICIT NONE OPEN(ULOC,FILE='DRIFTER.INP',ACTION='READ') @@ -396,10 +395,10 @@ SUBROUTINE CONTAINER(XLA,YLA,ZLA,LLA,KLA,NP) !******************************** INTEGER(4),INTENT(IN),OPTIONAL::NP INTEGER(4),INTENT(INOUT)::LLA(:),KLA(:) REAL(RKD) ,INTENT(INOUT)::ZLA(:) - INTEGER(4)::IPD,NPSTAT,LLA1,LLA2,KLA1 + INTEGER(4)::NPSTAT,LLA1,LLA2 INTEGER(4)::NI,LMILOC(1),K,L,N1,N2,I,J,ILN,JLN - INTEGER(4)::I1,I2,J1,J2,ITER,IPMC,JPMC - REAL(RKD) ::RADLA(LA),ZSIG,SCALE + INTEGER(4)::I1,I2,J1,J2 + REAL(RKD) ::RADLA(LA),SCALE LOGICAL(4)::MASK1,MASK2,MASK3,MASK4 LOGICAL(4)::CMASK,CMASK1,CMASK2,CMASK3,CMASK4 LOGICAL(4)::CPOS1,CPOS2,CPOS3,CPOS4 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index 63072c53f..fe00eb5fe 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -28,7 +28,6 @@ C INTEGER::IMIN,JMIN,KMIN,NMD,ITMP,ICALLTP,LS INTEGER::IPLTTMP,NRESTO,ISSREST,IRRMIN,ILOGC INTEGER::LN,LNW,LSE,LF,LL,LSW - INTEGER::I1,I2 REAL::T1TMP,SALMIN,HPPTMP,WTM,WTMP REAL::DELVOL,SALMAX,TAUB2,DELTD2,DZDDELT,TTMP REAL::TAUBC,TAUBC2,UTMP,VTMP,CURANG diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index e38a8aa75..b7d772630 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -30,7 +30,6 @@ C REAL TTMP, T1TMP, TMP, SECNDS - INTEGER::I1,I2 INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::ISSBCP LOGICAL BTEST, LTEST diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index e17f97af0..fb72436a3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -4778,7 +4778,7 @@ C FUNCTION PARSE_REAL(INLINE) CHARACTER*(*) INLINE - CHARACTER*15 CVAL,TMPVAL + CHARACTER*15 CVAL ILEN=LEN_TRIM(INLINE) PARSE_REAL=0. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for index 257755fd9..605bda5f1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for @@ -6,9 +6,9 @@ IMPLICIT NONE - INTEGER(4):: NP1, I, J, K - REAL(RKD) :: XC(4), YC(4), AREA2, RANVAL - REAL(8), EXTERNAL::DRAND + INTEGER(4):: NP1 + REAL(RKD) :: RANVAL + REAL(8) :: DRAND REAL(RKD) :: OILAREAP REAL(RKD) :: ACCRAD diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for index 0d8d040d4..f213abeb9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for @@ -8,7 +8,7 @@ C C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? USE GLOBAL - CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE5 + CHARACTER*80 TITLE1,TITLE2,TITLE3 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::ABTMP IF(.NOT.ALLOCATED(ABTMP))THEN ALLOCATE(ABTMP(KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index 7377c9140..e02baa9f8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -31,7 +31,7 @@ C PARAMETER (CONV1=1.0E3,CONV2=8.64E4) PMC Single Line REAL XMRM1, XMRM2, XMRM3,XMRM4,XMRMA,XMRMB,XMRMC,XMRMD, ! MACROALGAE & XMRME REAL XPSQ,XDSQ,XMUD - INTEGER M,N1,II,JJ,KK,M1,NT,ISSKIP,NW,ND,LF,LL,L,nsp + INTEGER M,N1,II,JJ,KK,NT,ISSKIP,NW,ND,LF,LL,L,nsp INTEGER IWQDT,IWQKIN,ITMP,IZ,IN,IJKC,IWQZX,IZMUD,IZSAND INTEGER IZANOX,MDUM ! Variables for benthic flux for anoxic env INTEGER I,J,K @@ -41,7 +41,6 @@ C PARAMETER (CONV1=1.0E3,CONV2=8.64E4) PMC Single Line REAL WQKGX1(NXSP),WQKGX2(NXSP),WQKGPX1(NXSP) ! C05 in WQ3DWC2.INP & ,WQKGPX2(NXSP) REAL WQTRX(NXSP),WQKTBX(NXSP) ! C06 in WQ3DWC2.INP - REAL XWQVX(NXSP) CHARACTER*80 FLN integer iww(100),jww(100) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for index d8c473812..58be588e7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for @@ -8,8 +8,8 @@ C CHARACTER*11 FNWQSR(40) CHARACTER*2 SNUM - INTEGER*4 I,NT,NW,IS,NS,ISO,ISTYP,K,M,M1,M2,LL,L,NSID - REAL RMULADJ,ADDADJ,CSERTMP,TIME,TDIFF,WTM1,WTM2 + INTEGER*4 NT,NW,IS,NS,ISO,ISTYP,K,M + REAL RMULADJ,ADDADJ,CSERTMP CHARACTER*12 FNWQSRX(NXSP) ! X-species INTEGER*4 nsp ! Number of x-species. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for index 3307c1eb7..f0f701b70 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for @@ -4,7 +4,7 @@ C CHANGE RECORD C READ IN SPATIALLY AND/OR TEMPORALLY VARYING ICS (UNIT INWQICI). C USE GLOBAL - CHARACTER TITLE(3)*79, ICICONT*3 + CHARACTER TITLE(3)*79 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XWQV IF(.NOT.ALLOCATED(XWQV))THEN ALLOCATE(XWQV(NWQVM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for index ecd98da09..f56ba647b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for @@ -12,7 +12,7 @@ C USE GLOBAL !{GeoSR, 2014.09.16. YSSONG - INTEGER::L,K,NS,NT + INTEGER::L,K,NT !} IF(ISTRAN(5).GE.1)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for index 6869fb9b4..90811026b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for @@ -52,7 +52,6 @@ C CHARACTER*50 TITLEB,TITLEC CHARACTER*20 HYDFIL REAL*8 AUX,AUX1 - CHARACTER*20 SEGFIL ! 7-1-2005 A Stoddard C INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:)::LAUX INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LDTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 index 6a3469b25..30c349b41 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 @@ -114,7 +114,7 @@ SUBROUTINE WINDWAVECAL ! WVFRQL(L) - WAVE FREQENCY (SEC) ! WV%TWX(L),WV%TWY(L) INTEGER(4) ::L,ZONE - REAL(RKD) ::FW,WB,TAUW,TP + REAL(RKD) ::TP REAL(RKD) ::AVEDEP,WVEL2,FC1,FC2,FC3 REAL(RKD) ::WDIR ! WIND DIRECTION IN DEG [0,360] REAL(RKD) ::WINX,WINY !IN CURVI-LINEAR SYS @@ -220,7 +220,7 @@ SUBROUTINE FETCH !OUTPUT: FWDIR(2:LA,1:NZONE) IN M USE DRIFTER,ONLY:INSIDECELL REAL(RKD)::AL(NZONE),RL,XM,YM,RL0 - INTEGER(4)::I,J,L,NZ,IM,JM,LM,STATUS,MUL + INTEGER(4)::I,J,L,NZ,IM,JM,LM,STATUS OPEN(UFET,FILE='FETCH.OUT') FWDIR = 0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for index fe7122169..782002104 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for @@ -38,7 +38,7 @@ C REAL TMP19,TEMFAC,DTWQxH,DTWQxH2,WQA19C,WQA19D,WQA19G REAL WQA19,WQA19A,WQSUM,WQRea,WQPOC,WQDOC,WQNH3,WQCOD REAL WQT20,WQR21,TIMTMP,WQTAMD - REAL WQT22,PPCDO,TMP22,WQA22,WQA22C,WQA22D,WQA22G + REAL PPCDO,TMP22,WQA22,WQA22C,WQA22D,WQA22G REAL WQCDSUM,WQCDREA,WQCDDOC REAL CHL_ABOVE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 index 3a00e0475..fdc1dd36a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 @@ -2,7 +2,7 @@ SUBROUTINE SEDZLJ_MAIN USE GLOBAL IMPLICIT NONE - DOUBLE PRECISION,DIMENSION(LCM)::WVEL,CLEFT,CRIGHT,GRADSED,SEDAVG,CRNUM,CRAIG + DOUBLE PRECISION,DIMENSION(LCM)::WVEL,CLEFT,CRIGHT,GRADSED,SEDAVG,CRNUM INTEGER::L,K,NS DOUBLE PRECISION::AA11,AA12,AA21,AA22,BB11,BB22,DETI ! PT: real values are written in DOUBLE PRECISION. 7/16/08 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 index f7c0be655..b5d2a90ba 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 @@ -9,7 +9,7 @@ SUBROUTINE MORPHJ !INTEGER::ITMP,K,L,LL,NS,NT !REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DELBED DOUBLE PRECISION::TMPVAL - INTEGER::ITMP,K,L,LL,NS,NT + INTEGER::ITMP,K,L,NS,NT !PT: real value are written in DOUBLE PRECISION. 7/16/08 DOUBLE PRECISION,SAVE,ALLOCATABLE,DIMENSION(:)::DELBED IF(.NOT.ALLOCATED(DELBED)) THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 index 5f4250cfc..63f5da5f0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 @@ -1,12 +1,11 @@ SUBROUTINE SEDIC USE GLOBAL IMPLICIT NONE - INTEGER::CORE,I,INCORE,J,L,LL,M,K,NS,VAR_BED,NSCICM,FDIR,NWV + INTEGER::CORE,I,INCORE,J,L,LL,M,K,NS,VAR_BED,FDIR,NWV INTEGER::IWV,JWV,NSKIP CHARACTER(LEN=80)::STR_LINE !PT- real values are written in DOUBLE PRECISION. 7/16/08 - DOUBLE PRECISION::BLKTMP,STWVHTMP,STWVTTMP,STWVDTMP - DOUBLE PRECISION,DIMENSION(10)::PTEMP + DOUBLE PRECISION::STWVHTMP,STWVTTMP,STWVDTMP DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:)::BDEN !(INCORE,KB) DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:)::TAUTEMP !(KB) DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:)::PNEW !(INCORE,KB,NSCM) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 index 7ec0e9671..12b770988 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 @@ -1,7 +1,7 @@ SUBROUTINE SEDZLJ(L) USE GLOBAL IMPLICIT NONE - INTEGER::KK,LL,K,L + INTEGER::LL,K,L INTEGER::NSC0,NSC1,NTAU0,NTAU1 REAL::T1TMP, T2TMP DOUBLE PRECISION::WDTDZ @@ -9,7 +9,7 @@ SUBROUTINE SEDZLJ(L) DOUBLE PRECISION::SN01 DOUBLE PRECISION::SN10 DOUBLE PRECISION::SN11 - DOUBLE PRECISION,DIMENSION(NSCM)::PX,PY,PFY,PROB,SMASS,MASSPCB,CSEDSS + DOUBLE PRECISION,DIMENSION(NSCM)::PX,PY,PFY,PROB,SMASS,CSEDSS DOUBLE PRECISION::D50TMPP,TEMP,TEMP2 DOUBLE PRECISION::ESED diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 index 691482778..d053e7bdc 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 @@ -7,7 +7,7 @@ SUBROUTINE SEDZLJ_SHEAR INTEGER::M1,M2 INTEGER::FZONE !PT: All real values are explicitly written in DOUBLE PRECISION 7/16/08. - DOUBLE PRECISION::TEMP,MMW,SIGMAWV,JJW + DOUBLE PRECISION::MMW,SIGMAWV,JJW DOUBLE PRECISION::VELMAG,VELANG,DELW,APROUGH DOUBLE PRECISION::UTMP,VTMP DOUBLE PRECISION::WVLENGTH,WVANGLE,WFTIM diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/tecplot.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/tecplot.f90 index def7ee551..bb68eacf2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/tecplot.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/tecplot.f90 @@ -12,11 +12,10 @@ SUBROUTINE TECPLOT !********************************************* USE GLOBAL IMPLICIT NONE - INTEGER::I,J,LN,L,K,KK,ITEMPMSK,CRAIG - REAL::UTMP,VTMP,TEMPMSK,FLUXLOAD - REAL::UTMPA,VTMPA,TEMPSTINC,LONTEMP,LATTEMP + INTEGER::I,J,LN,L,K,KK,ITEMPMSK + REAL::TEMPMSK + REAL::UTMPA,VTMPA,TEMPSTINC REAL,DIMENSION(KC)::CTEMP1 - REAL,DIMENSION(LCM,KC)::UTECPLOT,VTECPLOT REAL,DIMENSION(LCM)::UTMPS,VTMPS integer,save::nstep real::deltat From 231c08c76df3750c73f97243313d24aeedcd12eb Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 16:21:54 +0100 Subject: [PATCH 08/77] Resolve warning regarding lines with unused labels This resolves the warnings raised by the compiler due to lines containing unused jump labels. For lines that only contain format specifiers or CONTINUE statements, the lines are commented. For lines that contain other instructions, such as calls to READ, only the label is removed. --- .../original_efdc_files/BAL2T3A.for | 2 +- .../original_efdc_files/BAL2T3B.for | 2 +- .../original_efdc_files/BEDLOAD.for | 4 +- .../original_efdc_files/BEDPLTH.for | 26 +++---- .../original_efdc_files/BUDGET3.for | 2 +- .../original_efdc_files/BUDGET5.for | 22 +++--- .../original_efdc_files/CALCONC.for | 8 +- .../original_efdc_files/CALCSER.for | 2 +- .../original_efdc_files/CALEXP.for | 4 +- .../original_efdc_files/CALEXP2T.for | 6 +- .../original_efdc_files/CALHEAT.for | 2 +- .../original_efdc_files/CALIMP2T.for | 2 +- .../original_efdc_files/CALPUV2C.for | 68 ++++++++--------- .../original_efdc_files/CALPUV2T.for | 62 +++++++-------- .../original_efdc_files/CALPUV9.for | 60 +++++++-------- .../original_efdc_files/CALPUV9C.for | 66 ++++++++-------- .../original_efdc_files/CALQQ1.for | 10 +-- .../original_efdc_files/CALQQ1OLD.for | 10 +-- .../original_efdc_files/CALQQ2T.for | 10 +-- .../original_efdc_files/CALQQ2TOLD.for | 10 +-- .../original_efdc_files/CALQVS.for | 12 +-- .../original_efdc_files/CALSED.for | 2 +- .../original_efdc_files/CALSND.for | 2 +- .../original_efdc_files/CALSTEP.for | 6 +- .../original_efdc_files/CALSTEPD.for | 6 +- .../original_efdc_files/CALTBXY.for | 12 +-- .../original_efdc_files/CALTOX.for | 14 ++-- .../original_efdc_files/CALTOXB.for | 2 +- .../original_efdc_files/CALUVW.for | 14 ++-- .../original_efdc_files/CELLMAP.for | 76 +++++++++---------- .../original_efdc_files/CEQICM.for | 34 ++++----- .../original_efdc_files/CONGRAD.for | 2 +- .../original_efdc_files/COSTRAN.for | 4 +- .../original_efdc_files/COSTRANW.for | 6 +- .../original_efdc_files/CSNDEQC.for | 2 +- .../original_efdc_files/DEPPLT.for | 2 +- .../original_efdc_files/DUMP.for | 14 ++-- .../original_efdc_files/HDMT.for | 6 +- .../original_efdc_files/HDMT2T.for | 10 +-- .../original_efdc_files/INPUT.for | 26 +++---- .../original_efdc_files/JPEFDC.for | 8 +- .../original_efdc_files/NEGDEP.for | 2 +- .../original_efdc_files/OUT3D.for | 8 +- .../original_efdc_files/OUTPUT2.for | 14 ++-- .../original_efdc_files/PPLOT.for | 2 +- .../original_efdc_files/RCAHQ.for | 4 +- .../original_efdc_files/READOIL.for | 2 +- .../original_efdc_files/READWIMS2.for | 2 +- .../original_efdc_files/RESTIN1.for | 12 +-- .../original_efdc_files/RESTIN10.for | 4 +- .../original_efdc_files/RESTIN2.for | 4 +- .../original_efdc_files/RESTOUT.for | 2 +- .../original_efdc_files/ROUT3D.for | 8 +- .../original_efdc_files/RSALPLTH.for | 2 +- .../original_efdc_files/RSMICI.for | 2 +- .../original_efdc_files/RSMRST.for | 2 +- .../original_efdc_files/RSURFPLT.for | 2 +- .../original_efdc_files/RWQAGR.for | 2 +- .../original_efdc_files/RWQBEN2.for | 4 +- .../original_efdc_files/RWQC1.for | 14 ++-- .../original_efdc_files/RWQCSR.for | 3 +- .../original_efdc_files/RWQICI.for | 2 +- .../original_efdc_files/RWQPSL.for | 2 +- .../original_efdc_files/RWQRST.for | 2 +- .../original_efdc_files/RWQSTL.for | 2 +- .../original_efdc_files/SALPLTH.for | 4 +- .../original_efdc_files/SALTSMTH.for | 2 +- .../original_efdc_files/SCANGATECTL.for | 4 +- .../original_efdc_files/SCANMASK.for | 4 +- .../original_efdc_files/SMRIN1.for | 6 +- .../original_efdc_files/SSEDTOX.for | 10 +-- .../original_efdc_files/SUBCHAN.for | 2 +- .../original_efdc_files/VSFP.for | 2 +- .../original_efdc_files/WASP4.for | 10 +-- .../original_efdc_files/WASP5.for | 14 ++-- .../original_efdc_files/WASP6.for | 12 +-- .../original_efdc_files/WASP7.for | 16 ++-- .../original_efdc_files/WASP7EPA.for | 16 ++-- .../original_efdc_files/WAVEBL.for | 4 +- .../original_efdc_files/WAVESXY.for | 4 +- .../original_efdc_files/WQSKE0.for | 12 +-- .../original_efdc_files/WQSKE1.for | 4 +- .../original_efdc_files/WQSKE2.for | 2 +- .../original_efdc_files/WQSKE3.for | 3 +- .../original_efdc_files/WQSKE4.for | 2 +- .../original_efdc_files/WWQTSBIN.for | 2 +- .../original_efdc_files/foodchain.for | 6 +- 87 files changed, 440 insertions(+), 442 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for index 172fbb362..bc21f48ab 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3A.for @@ -322,7 +322,7 @@ C ENDDO ENDDO ENDIF - 800 FORMAT('N,NS,SNDFBL2T,DEL',2I5,2E14.5) +C 800 FORMAT('N,NS,SNDFBL2T,DEL',2I5,2E14.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for index 7bb6498a9..028318e00 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for @@ -119,7 +119,7 @@ C ENDIF ENDDO ENDIF - 800 FORMAT('N,NS,SNDFBL2T,DEL',2I5,2E14.5) +C 800 FORMAT('N,NS,SNDFBL2T,DEL',2I5,2E14.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDLOAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDLOAD.for index 407de0344..7174640a1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDLOAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDLOAD.for @@ -508,8 +508,8 @@ C SNDFBLTOT=SNDFBLTOT+DXYP(L)*SNDFBL(L,NX) ENDIF ENDDO - 8999 FORMAT(' BL ',3I5,5E14.5) - 8862 FORMAT(' SNDFBLTOT,QSBLLDXY',3I5,5E14.5) +C8999 FORMAT(' BL ',3I5,5E14.5) +C8862 FORMAT(' SNDFBLTOT,QSBLLDXY',3I5,5E14.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for index 5b469526c..7ea6c479e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for @@ -186,7 +186,7 @@ C ENDDO CLOSE(1) ENDIF - 339 FORMAT(2I5,6F14.5) +C 339 FORMAT(2I5,6F14.5) 103 FORMAT(3I5,18E13.5) 101 FORMAT(2I5,18E13.5) 102 FORMAT(10X,18E13.5) @@ -197,21 +197,21 @@ C 114 FORMAT(' IL JL PORBED(K=1,KB)') 115 FORMAT(' IL JL ZBEDB HBEDT HBED(K=1,KB)') 116 FORMAT(' IL JL BDENBED(K=1,KB)') - 118 FORMAT(' IL JL SEDT(K=1,KC)') - 119 FORMAT(' IL JL SNDT(K=1,KC)') - 120 FORMAT(' IL JL QSBDLDX QSBDLDY') - 121 FORMAT(' IL JL TOXB(K=1,KB,NT) NT = ',I5) +C 118 FORMAT(' IL JL SEDT(K=1,KC)') +C 119 FORMAT(' IL JL SNDT(K=1,KC)') +C 120 FORMAT(' IL JL QSBDLDX QSBDLDY') +C 121 FORMAT(' IL JL TOXB(K=1,KB,NT) NT = ',I5) 131 FORMAT(' IL JL (SEDFDTAP SEDFDTAN)(1,NSED)', & ' (SNDFDTAP SNDFDTAN)(1,NSND)') 122 FORMAT(F12.5,' TIME OF OUTPUT') - 906 FORMAT(5E17.8) - 907 FORMAT(13E17.8) - 908 FORMAT(12I10) - 909 FORMAT(I20,4X,F12.4) - 910 FORMAT(6I5,2X,E17.8,2X,E17.8) - 911 FORMAT(2I5,2X,6E13.4) - 912 FORMAT(3I5,12F7.3) - 913 FORMAT(6I5,4F7.3) +C 906 FORMAT(5E17.8) +C 907 FORMAT(13E17.8) +C 908 FORMAT(12I10) +C 909 FORMAT(I20,4X,F12.4) +C 910 FORMAT(6I5,2X,E17.8,2X,E17.8) +C 911 FORMAT(2I5,2X,6E13.4) +C 912 FORMAT(3I5,12F7.3) +C 913 FORMAT(6I5,4F7.3) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET3.for index b8ffe75d1..35fce8a3d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET3.for @@ -200,7 +200,7 @@ C ENDDO ENDDO ENDIF - 600 FORMAT(' VOLCON,VOLMAS = ',2E14.6) +C 600 FORMAT(' VOLCON,VOLMAS = ',2E14.6) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for index fae350b70..eac5ae220 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for @@ -14,7 +14,7 @@ C C ** CHECK FOR END OF BALANCE PERIOD C IF(NBUD.EQ.NTSMMT)THEN - 6666 FORMAT(' ACTIVE CALL TO BUDGET5, N,NBUD = ',2I5) +C6666 FORMAT(' ACTIVE CALL TO BUDGET5, N,NBUD = ',2I5) C C ** CALCULATE ENDING SUSPENDED AND BOTTOM SEDIMENT IN THE MODEL DOMAIN C @@ -190,16 +190,16 @@ C CLOSE(89) CLOSE(93) CLOSE(94) - 9510 FORMAT(//' SUS AND BED SED BUDGET ENDING AT N =',I7/) - 9511 FORMAT(' SEDIN,SEDOUT,SDFLUX = ',3E15.7/) - 9512 FORMAT(' SSEDBEG,BSEDBEG = ',2E15.7/) - 9513 FORMAT(' SSEDOUT,BSEDOUT = ',2E15.7/) - 9514 FORMAT(' SSEDBMO,BSEDBMO = ',2E15.7/) - 9515 FORMAT(' SSEDEND,BSEDEND = ',2E15.7/) - 9516 FORMAT(' SSEDERR,BSEDERR = ',2E15.7/) - 9517 FORMAT(' SSEDERE,BSEDERE = ',2E15.7/) - 9600 FORMAT(/'C ACCUMULATED SED FLUX AT N = ',I5) - 9601 FORMAT(2I5,5E15.7) +C9510 FORMAT(//' SUS AND BED SED BUDGET ENDING AT N =',I7/) +C9511 FORMAT(' SEDIN,SEDOUT,SDFLUX = ',3E15.7/) +C9512 FORMAT(' SSEDBEG,BSEDBEG = ',2E15.7/) +C9513 FORMAT(' SSEDOUT,BSEDOUT = ',2E15.7/) +C9514 FORMAT(' SSEDBMO,BSEDBMO = ',2E15.7/) +C9515 FORMAT(' SSEDEND,BSEDEND = ',2E15.7/) +C9516 FORMAT(' SSEDERR,BSEDERR = ',2E15.7/) +C9517 FORMAT(' SSEDERE,BSEDERE = ',2E15.7/) +C9600 FORMAT(/'C ACCUMULATED SED FLUX AT N = ',I5) +C9601 FORMAT(2I5,5E15.7) 888 FORMAT (6X,' SEDIMENT BUDGET CALCULATIONS'// & 6X,'SEDIMENT BUDGET OVER ',I5,' TIME STEPS'/ & 6X,'STARTING ON JULIAN DAY ',F6.2/ diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 5b52803e9..0d8c0e454 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -56,7 +56,7 @@ C C C ** VERTICAL DIFFUSION EXPLICIT HALF STEP CALCULATION C - 500 CONTINUE +C 500 CONTINUE C C ** 3D ADVECTI0N TRANSPORT CALCULATION-COSMIC INITIALIZATION C @@ -455,8 +455,8 @@ C C TVDIF=TVDIF+SECNDS(TTMP) ENDIF C - 888 FORMAT('N,IC,I,DTS,DT = ',3I5,2F12.8) - 889 FORMAT('N,IC,I,DTS = ',3I5,F12.8,12X,'SSEDTOX CALLED') +C 888 FORMAT('N,IC,I,DTS,DT = ',3I5,2F12.8) +C 889 FORMAT('N,IC,I,DTS = ',3I5,F12.8,12X,'SSEDTOX CALLED') C C ** OPTIONAL MASS BALANCE CALCULATION C @@ -939,7 +939,7 @@ C ENDDO ENDIF C - 6222 FORMAT(' TC,SNEW,SASSM,SOLD=',4F10.2) +C6222 FORMAT(' TC,SNEW,SASSM,SOLD=',4F10.2) C IF(ISCDA(7).GT.0)THEN DO NX=1,NSND diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER.for index 98cece3fd..cd18f3595 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER.for @@ -318,7 +318,7 @@ C SFNTBET=WTM1*SFNTBE(M1)+WTM2*SFNTBE(M2) SFATBTT=WTM1*SFATBT(M1)+WTM2*SFATBT(M2) 400 CONTINUE - 6000 FORMAT('N, CSERT(1),CSERT(KC) = ',I6,4X,2F12.2) +C6000 FORMAT('N, CSERT(1),CSERT(KC) = ',I6,4X,2F12.2) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP.for index e56b82c3d..fc5224536 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP.for @@ -446,7 +446,7 @@ C & U(L+1,K),U(L,K),DXV(LN),DXV(L),HP(L),CAC(L,K) C ENDDO C CLOSE(1) C ENDIF - 1111 FORMAT(3I5,10E13.4) +C1111 FORMAT(3I5,10E13.4) C C**********************************************************************C C @@ -960,7 +960,7 @@ C CLOSE(1) ENDIF C - 1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) +C1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for index 9563da03b..47f8dfd18 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for @@ -669,8 +669,8 @@ C C ENDIF C - 1947 FORMAT(3I5,10E12.4) - 1948 FORMAT(15X,10E12.4) +C1947 FORMAT(3I5,10E12.4) +C1948 FORMAT(15X,10E12.4) C C**********************************************************************C C @@ -1218,7 +1218,7 @@ C IF(N.LE.4)THEN C CLOSE(1) C ENDIF C - 1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) +C1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index 8b4ec6bb6..241507f41 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -612,7 +612,7 @@ c & -TATMT(L)) ENDDO ENDIF - 600 FORMAT(4I5,2E12.4) +C 600 FORMAT(4I5,2E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for index fcd6866e6..7098ac506 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for @@ -504,7 +504,7 @@ C & (BELV(L)-BELV(LS)+Z(K)*(HP(L)-HP(LS))) ) ENDDO ENDDO - 1111 FORMAT(2I5,2X,8E12.4) +C1111 FORMAT(2I5,2X,8E12.4) C C ** CALCULATE EXPLICIT INTERNAL U AND V SHEAR EQUATION TERMS C ELSE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for index 232403bfa..16a469010 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for @@ -588,7 +588,7 @@ C ENDIF ENDIF 1001 FORMAT(2I5,10(1X,E12.4)) - 1002 FORMAT(3I4,10(1X,E9.2)) +C1002 FORMAT(3I4,10(1X,E9.2)) C C ** CALCULATE UHEX AND VHEX AND TOTAL DEPTHS AT TIME LEVEL (N+1) C ** HRU=SUB*DYU/DXU & HRV=SVB*DXV/DYV @@ -740,9 +740,9 @@ C GOTO 1000 ENDIF ENDIF - 6960 FORMAT(' NCORDRY =', I5) - 6961 FORMAT(' UNSTABLE, NCORDRY =', I5) - 9999 CONTINUE +C6960 FORMAT(' NCORDRY =', I5) +C6961 FORMAT(' UNSTABLE, NCORDRY =', I5) +C9999 CONTINUE C C ** CHECK FOR DRYING AND RESOLVE EQUATIONS IF NECESSARY C @@ -1122,34 +1122,34 @@ C C ** CHECK FOR NEGATIVE DEPTHS C IF(ISNEGH.GE.1)CALL NEGDEP(QCHANUT,QCHANVT,2) - 6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' - & ,3(2X,E12.4)) - 6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' - & ,3(2X,E12.4)) - 6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' - & ,3(2X,E12.4)) - 6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' - & ,3(2X,E12.4)) - 6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) +C6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' +C & ,3(2X,E12.4)) +C6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' +C & ,3(2X,E12.4)) +C6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' +C & ,3(2X,E12.4)) +C6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' +C & ,3(2X,E12.4)) +C6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) 8001 FORMAT(I7,5I5,4E13.4) 8002 FORMAT(17X,3I5,4E13.4) 8003 FORMAT(32X,4E13.4) @@ -1187,7 +1187,7 @@ C WRITE(6,6628)DIVEXMX,IMAX,JMAX WRITE(6,6629)DIVEXMN,IMIN,JMIN ENDIF - 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) +C 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) 6628 FORMAT(' DIVEXMX=',E13.5,5X,2I10) 6629 FORMAT(' DIVEXMN=',E13.5,5X,2I10) C @@ -1205,7 +1205,7 @@ C VOLZERD=VOLZERD+VOLADD VETZERD=VETZERD+VOLADD+DT*EVAPSW(L) ENDIF - 5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) +C5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for index 0cafe0a06..ca0ca6a38 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for @@ -515,7 +515,7 @@ C ENDIF ENDIF 1001 FORMAT(2I5,10(1X,E12.4)) - 1002 FORMAT(3I4,10(1X,E9.2)) +C1002 FORMAT(3I4,10(1X,E9.2)) C C ** CALCULATE UHEX AND VHEX AND TOTAL DEPTHS AT TIME LEVEL (N+1) C ** HRU=SUB*DYU/DXU & HRV=SVB*DXV/DYV @@ -634,34 +634,34 @@ C ** CHECK FOR NEGATIVE DEPTHS C ISTLX=ISTL IF(ISNEGH.GE.1)CALL NEGDEP(QCHANUT,QCHANVT,ISTLX) - 6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' - & ,3(2X,E12.4)) - 6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' - & ,3(2X,E12.4)) - 6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' - & ,3(2X,E12.4)) - 6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' - & ,3(2X,E12.4)) - 6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) +C6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' +C & ,3(2X,E12.4)) +C6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' +C & ,3(2X,E12.4)) +C6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' +C & ,3(2X,E12.4)) +C6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' +C & ,3(2X,E12.4)) +C6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) C C ** CALCULATE THE EXTERNAL DIVERGENCE C @@ -692,7 +692,7 @@ C WRITE(6,6628)DIVEXMX,IMAX,JMAX WRITE(6,6629)DIVEXMN,IMIN,JMIN ENDIF - 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) +C 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) 6628 FORMAT(' DIVEXMX=',E13.5,5X,2I10) 6629 FORMAT(' DIVEXMN=',E13.5,5X,2I10) C @@ -710,7 +710,7 @@ C IF(ISDRY.GE.1.AND.ISTL.EQ.3)THEN VOLZERD=VOLZERD+VOLADD VETZERD=VETZERD+VOLADD+DT*EVAPSW(L) ENDIF - 5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) +C5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) C !CALL NOW_CHECK ! PMC TESTING C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for index 53cb7b0b8..e3efc61c0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for @@ -713,34 +713,34 @@ C 6062 FORMAT(' NEG DEPTH AT I,J =',2I4,' HUE,H1UE =',2(2X,E12.4)) 6063 FORMAT(' NEG DEPTH AT I,J =',2I4,' HVS,H1VS =',2(2X,E12.4)) 6064 FORMAT(' NEG DEPTH AT I,J =',2I4,' HVN,H1VN =',2(2X,E12.4)) - 6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' - & ,3(2X,E12.4)) - 6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' - & ,3(2X,E12.4)) - 6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' - & ,3(2X,E12.4)) - 6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' - & ,3(2X,E12.4)) - 6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) +C6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' +C & ,3(2X,E12.4)) +C6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' +C & ,3(2X,E12.4)) +C6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' +C & ,3(2X,E12.4)) +C6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' +C & ,3(2X,E12.4)) +C6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) C C ** CALCULATE THE EXTERNAL DIVERGENCE C @@ -791,7 +791,7 @@ C WRITE(6,6628)DIVEXMX,IMAX,JMAX WRITE(6,6629)DIVEXMN,IMIN,JMIN ENDIF - 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) +C 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) 6628 FORMAT(' DIVEXMX=',E13.5,5X,2I10) 6629 FORMAT(' DIVEXMN=',E13.5,5X,2I10) C @@ -808,7 +808,7 @@ C VOLZERD=VOLZERD+VOLADD VETZERD=VETZERD+VOLADD+DT*EVAPSW(L) ENDIF - 5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) +C5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for index ee15f0d20..7fcc08815 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for @@ -861,9 +861,9 @@ C GOTO 1000 ENDIF ENDIF - 6960 FORMAT(' NCORDRY =', I5) - 6961 FORMAT(' UNSTABLE, NCORDRY =', I5) - 9999 CONTINUE +C6960 FORMAT(' NCORDRY =', I5) +C6961 FORMAT(' UNSTABLE, NCORDRY =', I5) +C9999 CONTINUE C C ** PERFORM FINAL UPDATES OF P,HU, AND HV C @@ -1031,34 +1031,34 @@ C 8001 FORMAT(5I5,3E13.4) 8002 FORMAT(10X,3I5,3E13.4) 8000 FORMAT(' NMD MTYP I J IDRY P H Q') - 6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) - 6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) - 6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' - & ,3(2X,E12.4)) - 6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' - & ,3(2X,E12.4)) - 6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' - & ,3(2X,E12.4)) - 6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' - & ,3(2X,E12.4)) - 6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) - 6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' - & ,3(2X,E12.4)) +C6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' +C & ,3(2X,E12.4)) +C6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' +C & ,3(2X,E12.4)) +C6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' +C & ,3(2X,E12.4)) +C6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' +C & ,3(2X,E12.4)) +C6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) C C ** CALCULATE THE EXTERNAL DIVERGENCE C @@ -1109,7 +1109,7 @@ C WRITE(6,6628)DIVEXMX,IMAX,JMAX WRITE(6,6629)DIVEXMN,IMIN,JMIN ENDIF - 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) +C 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) 6628 FORMAT(' DIVEXMX=',E13.5,5X,2I10) 6629 FORMAT(' DIVEXMN=',E13.5,5X,2I10) C @@ -1126,7 +1126,7 @@ C VOLZERD=VOLZERD+VOLADD VETZERD=VETZERD+VOLADD+DT*EVAPSW(L) ENDIF - 5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) +C5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1.for index 42b31348a..947090d05 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1.for @@ -465,11 +465,11 @@ C *** DSLLC BEGIN BLOCK ENDDO ENDDO C *** DSLLC END BLOCK - 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', - & ' PROD+ADV 1./DIAGON') - 111 FORMAT(2I5,5E14.5) - 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) - 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1OLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1OLD.for index 86008d0e0..cb9a44ea2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1OLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ1OLD.for @@ -434,11 +434,11 @@ C *** DSLLC BEGIN BLOCK ENDDO ENDDO C *** DSLLC END BLOCK - 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', - & ' PROD+ADV 1./DIAGON') - 111 FORMAT(2I5,5E14.5) - 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) - 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for index 5e96f5a42..6a0dfebca 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T.for @@ -528,11 +528,11 @@ C *** DSLLC BEGIN BLOCK ENDDO ENDDO C *** DSLLC END BLOCK - 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', - & ' PROD+ADV 1./DIAGON') - 111 FORMAT(2I5,5E14.5) - 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) - 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for index a48c845fe..11b0dd6fa 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD.for @@ -508,11 +508,11 @@ C *** DSLLC BEGIN BLOCK ENDDO ENDDO C *** DSLLC END BLOCK - 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', - & ' PROD+ADV 1./DIAGON') - 111 FORMAT(2I5,5E14.5) - 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) - 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for index 584d08d7f..4f7b92c85 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS.for @@ -651,14 +651,14 @@ C ENDIF 101 FORMAT(' SOURCE/SINK DIAGNOSTICS AT TIME STEP =',I8,//) 102 FORMAT(3X,'CONST NQSIJ SOURCE/SINK FLOW AT I =',I5,' J =',I5,/) - 103 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K,1) = ',E12.4, - & 5X,'CQS(K,5) = ',E12.4) - 203 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K, ) = ', - & 5X, 12E12.4) +C 103 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K,1) = ',E12.4, +C & 5X,'CQS(K,5) = ',E12.4) +C 203 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K, ) = ', +C & 5X, 12E12.4) 104 FORMAT(/) 105 FORMAT(3X,'TIME VAR NQSIJ SOURCE/SINK FLOW AT I =',I5,' J=',I5,/) - 106 FORMAT(5X,'K =',I5,5X,'QSERT(K) = ',E12.4, - & 5X,'CSERT(K,1) = ',E12.4,5X,'CSERT(K,5) = ',E12.4) +C 106 FORMAT(5X,'K =',I5,5X,'QSERT(K) = ',E12.4, +C & 5X,'CSERT(K,1) = ',E12.4,5X,'CSERT(K,5) = ',E12.4) 206 FORMAT(5X,'NQ,LQ =',2I4,7X,'QSERT() = ',12E12.4) 207 FORMAT(5X,'NQ,NT,NCQ =',3I4,3X,'CSERT() = ',12E12.4) 216 FORMAT(5X,'NQ,LQ =',2I4,3X,'QSS() = ',12E12.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for index bdaf45e29..e3d8da474 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for @@ -802,7 +802,7 @@ C C C WRITE(11,6111)TIME,(WSETA(857,K,1),K=0,KS) C WRITE(41,6111)TIME,(STRESSS(K),K=0,KS) - 6111 FORMAT(F10.2,10E12.4) +C6111 FORMAT(F10.2,10E12.4) C C----------------------------------------------------------------------C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for index 60990084b..7195f1fec 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for @@ -181,7 +181,7 @@ C C ENDIF C - 888 FORMAT(2I5,6E12.4) +C 888 FORMAT(2I5,6E12.4) C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for index 35f6c9eb7..148f47cd3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for @@ -282,14 +282,14 @@ C C C ** WRITE TO TIME STEP LOG FILE C - 100 FORMAT(5I5,5F12.5,E13.5) - 101 FORMAT(3I5,E13.5) +C 100 FORMAT(5I5,5F12.5,E13.5) +C 101 FORMAT(3I5,E13.5) 800 FORMAT(' TIME,DTDYN,DTMIN,I,J = ',F12.5,2E12.4,2I7) 801 FORMAT(' MOM ADV,I,J,DTM = ',2I5,E13.4) 802 FORMAT(' MASS ADV,I,J,DTM = ',2I5,E13.4) 803 FORMAT(' CURV ACC,I,J,DTM = ',2I5,E13.4) 880 FORMAT(3I5,8E13.4) - 8899 FORMAT(' DT3 ERROR ',2I5,6E13.5) +C8899 FORMAT(' DT3 ERROR ',2I5,6E13.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for index d78b07fcf..49025cc26 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for @@ -302,14 +302,14 @@ C DTDYN=FLOAT(NTMP)*DTMIN ENDIF C - 100 FORMAT(5I5,5F12.5,E13.5) - 101 FORMAT(3I5,E13.5) +C 100 FORMAT(5I5,5F12.5,E13.5) +C 101 FORMAT(3I5,E13.5) 800 FORMAT(' TIME,DTDYN,DTMIN,I,J = ',F12.5,2E12.4,2I7) 801 FORMAT(' MOM ADV,I,J,DTM = ',2I5,E13.4) 802 FORMAT(' MASS ADV,I,J,DTM = ',2I5,E13.4) 803 FORMAT(' CURV ACC,I,J,DTM = ',2I5,E13.4) 880 FORMAT(3I5,8E13.4) - 8899 FORMAT(' DT3 ERROR ',2I5,6E13.5) +C8899 FORMAT(' DT3 ERROR ',2I5,6E13.5) C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for index da2389276..4bbeb8178 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for @@ -721,12 +721,12 @@ C ENDIF ENDIF 1948 CONTINUE - 1717 FORMAT(' N,I,J = ',I10,2I5,' CDTOTU,CDMAXU = ',2F15.10) - 1718 FORMAT(' N,I,J = ',I10,2I5,' CDTOTV,CDMAXV = ',2F15.10) - 1727 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTU,CDMAXU = ',2F15.10) - 1728 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTV,CDMAXV = ',2F15.10) - 1719 FORMAT(' N = ',I10,' CDTOTUM,CDTOTVM = ',2F15.10) - 1729 FORMAT(' N = ',I10,' CDMAXUM,CDMAXVM = ',2F15.10) +C1717 FORMAT(' N,I,J = ',I10,2I5,' CDTOTU,CDMAXU = ',2F15.10) +C1718 FORMAT(' N,I,J = ',I10,2I5,' CDTOTV,CDMAXV = ',2F15.10) +C1727 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTU,CDMAXU = ',2F15.10) +C1728 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTV,CDMAXV = ',2F15.10) +C1719 FORMAT(' N = ',I10,' CDTOTUM,CDTOTVM = ',2F15.10) +C1729 FORMAT(' N = ',I10,' CDMAXUM,CDMAXVM = ',2F15.10) 1739 FORMAT(' N,I,J = ',I10,2I5,' ZBRMAX,HBTLYMX = ',2E14.6) 1749 FORMAT(' N,I,J = ',I10,2I5,' ZBRMIN,HBTLYMN = ',2E14.6) 1759 FORMAT(' N,I,J = ',I10,2I5,' CDRGMAX,STBX,STBY = ',3E14.6) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for index fd7034e88..f52a57b8c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for @@ -204,7 +204,7 @@ C ENDDO ENDDO ENDIF - 1907 FORMAT(2I6,10E13.4) +C1907 FORMAT(2I6,10E13.4) C C ** CALCULATE TOXIC CONTAMINANT PARTICULATE FRACTIONS C ** IN SEDIMENT BED @@ -679,7 +679,7 @@ C ENDDO ENDDO - 8822 FORMAT(3I5,E14.5) +C8822 FORMAT(3I5,E14.5) IF(IS2TIM.GE.1) THEN IF(ISBAL.GE.1)THEN IF(NSBDLDBC.GT.0) THEN @@ -733,8 +733,8 @@ C TOXFBLT(NT)=TOXFBLT(NT)+DXYP(L)*TOXFBL(L,NT) ENDDO ENDDO - 8862 FORMAT('N,NX,SNDFBLTOT,QSBLLDXDY =',2I5,2E14.5) - 8899 FORMAT('N,TOXFBLT(NT),TOXBLB(NT)=',I5,2E14.5) +C8862 FORMAT('N,NX,SNDFBLTOT,QSBLLDXDY =',2I5,2E14.5) +C8899 FORMAT('N,TOXFBLT(NT),TOXBLB(NT)=',I5,2E14.5) C C END FIXED FOR BED LOAD JMH 5/22/02 C ** ADJUST TOXIC FLUXES ACROSS WATER COLUMN - BED INTERFACE TO @@ -793,8 +793,8 @@ C END ADJUST WC AND BED TOXIC CONSISTENT WITH FLUX C ENDDO - 676 FORMAT('N,L,T,TB,TT,T1.TB1,F,FB=',2I5,8E13.4) - 677 FORMAT('N,L,T,TB =',2I5,8E13.4) +C 676 FORMAT('N,L,T,TB,TT,T1.TB1,F,FB=',2I5,8E13.4) +C 677 FORMAT('N,L,T,TB =',2I5,8E13.4) ENDDO ENDIF @@ -1013,7 +1013,7 @@ C ENDDO ENDIF ENDIF - 8888 FORMAT(4I5,7E14.5) +C8888 FORMAT(4I5,7E14.5) 2222 FORMAT(2I5,7E14.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOXB.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOXB.for index e6f3f5001..7ce666856 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOXB.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOXB.for @@ -246,7 +246,7 @@ C ENDDO ENDDO ENDIF - 8999 FORMAT(' TAD ',2I10,5E14.5,2F10.5) +C8999 FORMAT(' TAD ',2I10,5E14.5,2F10.5) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for index 1615637de..b41b958cf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW.for @@ -214,10 +214,10 @@ C C C ** UNCOMMENT BELOW TO WRITE CONTINUITY DIAGNOSITCS C - 6661 FORMAT(' I,J,UHDYERMX = ',2I5,E14.5) - 6662 FORMAT(' I,J,UHDYERMN = ',2I5,E14.5) - 6663 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) - 6664 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) +C6661 FORMAT(' I,J,UHDYERMX = ',2I5,E14.5) +C6662 FORMAT(' I,J,UHDYERMN = ',2I5,E14.5) +C6663 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) +C6664 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) C C ** CALCULATE W C @@ -273,9 +273,9 @@ C ENDDO ENDDO - 601 FORMAT(' IMAX,JMAX,QWSFMAX = ',2I5,E14.5) - 602 FORMAT(' IMIN,JMIN,QWSFMIN = ',2I5,E14.5) - 603 FORMAT(' TOTAL SURF Q ERR = ',E14.5) +C 601 FORMAT(' IMAX,JMAX,QWSFMAX = ',2I5,E14.5) +C 602 FORMAT(' IMIN,JMIN,QWSFMIN = ',2I5,E14.5) +C 603 FORMAT(' TOTAL SURF Q ERR = ',E14.5) C C ** CALCULATE U AND V ON OPEN BOUNDARIES C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for index 9c0367724..1afaaab11 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for @@ -237,44 +237,44 @@ C !ENDDO ! 220 CONTINUE - 101 FORMAT(' LR,LTMP = ',2I6/) - 102 FORMAT(' LR,LTMP = ',2I6/) - 103 FORMAT(' LN= 1, LR,LTMP,ITMP,JTMP = ',4I6/) - 104 FORMAT(' LN=LC, LR,LTMP,ITMP,JTMP = ',4I6/) - 105 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) - 106 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) - 107 FORMAT(' LS= 1, LR,LTMP,ITMP,JTMP = ',4I6/) - 108 FORMAT(' LS=LC, LR,LTMP,ITMP,JTMP = ',4I6/) - 109 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) - 110 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) - 111 FORMAT(' LE= 1, LR,LTMP,ITMP,JTMP = ',4I6/) - 112 FORMAT(' LE=LC, LR,LTMP,ITMP,JTMP = ',4I6/) - 113 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) - 114 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) - 115 FORMAT(' LW= 1, LR,LTMP,ITMP,JTMP = ',4I6/) - 116 FORMAT(' LW=LC, LR,LTMP,ITMP,JTMP = ',4I6/) - 117 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) - 118 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) - 201 FORMAT(' LB,LTMP = ',2I6/) - 202 FORMAT(' LB,LTMP = ',2I6/) - 203 FORMAT(' LN= 1, LB,LTMP,ITMP,JTMP = ',4I6/) - 204 FORMAT(' LN=LC, LB,LTMP,ITMP,JTMP = ',4I6/) - 205 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) - 206 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) - 207 FORMAT(' LS= 1, LB,LTMP,ITMP,JTMP = ',4I6/) - 208 FORMAT(' LS=LC, LB,LTMP,ITMP,JTMP = ',4I6/) - 209 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) - 210 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) - 211 FORMAT(' LE= 1, LB,LTMP,ITMP,JTMP = ',4I6/) - 212 FORMAT(' LE=LC, LB,LTMP,ITMP,JTMP = ',4I6/) - 213 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) - 214 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) - 215 FORMAT(' LW= 1, LB,LTMP,ITMP,JTMP = ',4I6/) - 216 FORMAT(' LW=LC, LB,LTMP,ITMP,JTMP = ',4I6/) - 217 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) - 218 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) - 119 FORMAT(' SUB(LETMP) = ',F10.2/) - 120 FORMAT(' SUB(LTMP) = ',F10.2/) +C 101 FORMAT(' LR,LTMP = ',2I6/) +C 102 FORMAT(' LR,LTMP = ',2I6/) +C 103 FORMAT(' LN= 1, LR,LTMP,ITMP,JTMP = ',4I6/) +C 104 FORMAT(' LN=LC, LR,LTMP,ITMP,JTMP = ',4I6/) +C 105 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) +C 106 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) +C 107 FORMAT(' LS= 1, LR,LTMP,ITMP,JTMP = ',4I6/) +C 108 FORMAT(' LS=LC, LR,LTMP,ITMP,JTMP = ',4I6/) +C 109 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) +C 110 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) +C 111 FORMAT(' LE= 1, LR,LTMP,ITMP,JTMP = ',4I6/) +C 112 FORMAT(' LE=LC, LR,LTMP,ITMP,JTMP = ',4I6/) +C 113 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) +C 114 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) +C 115 FORMAT(' LW= 1, LR,LTMP,ITMP,JTMP = ',4I6/) +C 116 FORMAT(' LW=LC, LR,LTMP,ITMP,JTMP = ',4I6/) +C 117 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) +C 118 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) +C 201 FORMAT(' LB,LTMP = ',2I6/) +C 202 FORMAT(' LB,LTMP = ',2I6/) +C 203 FORMAT(' LN= 1, LB,LTMP,ITMP,JTMP = ',4I6/) +C 204 FORMAT(' LN=LC, LB,LTMP,ITMP,JTMP = ',4I6/) +C 205 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) +C 206 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/) +C 207 FORMAT(' LS= 1, LB,LTMP,ITMP,JTMP = ',4I6/) +C 208 FORMAT(' LS=LC, LB,LTMP,ITMP,JTMP = ',4I6/) +C 209 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) +C 210 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/) +C 211 FORMAT(' LE= 1, LB,LTMP,ITMP,JTMP = ',4I6/) +C 212 FORMAT(' LE=LC, LB,LTMP,ITMP,JTMP = ',4I6/) +C 213 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) +C 214 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/) +C 215 FORMAT(' LW= 1, LB,LTMP,ITMP,JTMP = ',4I6/) +C 216 FORMAT(' LW=LC, LB,LTMP,ITMP,JTMP = ',4I6/) +C 217 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) +C 218 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/) +C 119 FORMAT(' SUB(LETMP) = ',F10.2/) +C 120 FORMAT(' SUB(LTMP) = ',F10.2/) C C ** DEFINE MAPPING TO 3D GRAPHICS GRID C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for index 82e403d71..1663f44e2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for @@ -543,7 +543,7 @@ C LM=L-1 WRITE(14,402)LM,L,TVAR3C(L) ENDDO - 222 FORMAT(' ERROR ',2I5,6F12.2) +C 222 FORMAT(' ERROR ',2I5,6F12.2) 401 FORMAT(/,' LICM L QSUMLPF(L,K) K=1,KC',/) 402 FORMAT(2I6,12E13.5) 2294 FORMAT(2I6,4F12.5) @@ -728,33 +728,33 @@ C 103 FORMAT(/,' NO INTERNAL FLOWS, NINTFL (LINES) IN FLWMAP.INP = ', & I10/) 104 FORMAT(/,' ROW, COLUMN INDICES OF DUMP CELL = ',2I10/) - 105 FORMAT(/,' SIMULATION STARTING TIME IN DAYS = ',F12.6/) +C 105 FORMAT(/,' SIMULATION STARTING TIME IN DAYS = ',F12.6/) 106 FORMAT(/,' TIME IN DAYS AT END OF AVERAGING PERIOD = ',F12.6/) 110 FORMAT(' LOCATION OF INFLOWS ',/) 111 FORMAT(' INFLOW # ROW INDEX COLUMN INDEX ',/) 112 FORMAT(2X,I5,7X,I5,7X,I5) 120 FORMAT(F12.6,13F12.4) 200 FORMAT(3I5,6E14.6) - 201 FORMAT(' L,I(ROW),J(COL),QX(I,J,K),K=1,KC ',/) - 202 FORMAT(' L,I(ROW),J(COL),QY(I,J,K),K=1,KC ',/) - 203 FORMAT(' L,I(ROW),J(COL),QZ(I,J,K),K=1,KS ',/) - 204 FORMAT(' L,I(ROW),J(COL),AX(I,J,K),K=1,KC ',/) - 205 FORMAT(' L,I(ROW),J(COL),AY(I,J,K),K=1,KC ',/) - 206 FORMAT(' L,I(ROW),J(COL),AZ(I,J,K),K=1,KS ',/) - 207 FORMAT(' L,I(ROW),J(COL),SELS(I,J),SELE(I,J),DSEL(I,J) ',/) - 208 FORMAT(' L,I(ROW),J(COL),SAL(I,J,K),K=1,KC ',/) - 209 FORMAT(' L,I(ROW),J(COL),TEM(I,J,K),K=1,KC ',/) - 210 FORMAT(//) +C 201 FORMAT(' L,I(ROW),J(COL),QX(I,J,K),K=1,KC ',/) +C 202 FORMAT(' L,I(ROW),J(COL),QY(I,J,K),K=1,KC ',/) +C 203 FORMAT(' L,I(ROW),J(COL),QZ(I,J,K),K=1,KS ',/) +C 204 FORMAT(' L,I(ROW),J(COL),AX(I,J,K),K=1,KC ',/) +C 205 FORMAT(' L,I(ROW),J(COL),AY(I,J,K),K=1,KC ',/) +C 206 FORMAT(' L,I(ROW),J(COL),AZ(I,J,K),K=1,KS ',/) +C 207 FORMAT(' L,I(ROW),J(COL),SELS(I,J),SELE(I,J),DSEL(I,J) ',/) +C 208 FORMAT(' L,I(ROW),J(COL),SAL(I,J,K),K=1,KC ',/) +C 209 FORMAT(' L,I(ROW),J(COL),TEM(I,J,K),K=1,KC ',/) +C 210 FORMAT(//) 211 FORMAT(I5,2X,6E15.6) 212 FORMAT(' L,I(ROW),J(ROW),RAINLPF(I,J),EVPSLPF(I,J),EVPGLPF(I,J), & RINFLPF(I,J),GWLPF(I,J) ',/) 213 FORMAT(' NQINTFL,QINTFL ',/) - 215 FORMAT(' L,I(ROW),J(COL),SURFELV START AVG INTERVAL',/) - 216 FORMAT(' L,I(ROW),J(COL),DEL SURFELV OVER INTERVAL',/) - 291 FORMAT(I8,F8.4) - 292 FORMAT(I8,E13.5) +C 215 FORMAT(' L,I(ROW),J(COL),SURFELV START AVG INTERVAL',/) +C 216 FORMAT(' L,I(ROW),J(COL),DEL SURFELV OVER INTERVAL',/) +C 291 FORMAT(I8,F8.4) +C 292 FORMAT(I8,E13.5) 293 FORMAT(I8,E13.5,3I8) - 294 FORMAT(I8,E13.5,E13.5,3I8) +C 294 FORMAT(I8,E13.5,E13.5,3I8) 2001 FORMAT(/,' TIME AT ICM INTERFACE INITIALIZATION = ',F12.4,/) 2002 FORMAT(/,' SIGMA LAYER FRACTIONAL THICKNESS: KICM, DZ, KEFDC',/) 2003 FORMAT(/,' HORIZONTAL CELL SURFACE AREAS, TOP LAYER : LICM, AREA' diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for index 192c96c4a..5e090ad8e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for @@ -121,7 +121,7 @@ C ENDIF ! *** DSLLC END BLOCK TCONG=TCONG+SECNDS(TTMP) - 800 FORMAT(I5,8E13.4) +C 800 FORMAT(I5,8E13.4) 808 FORMAT(2I5,9E13.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for index ca07b88ad..f04daac31 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for @@ -501,7 +501,7 @@ C ENDIF ENDDO ENDDO - 6001 FORMAT('N,K,CBTS = ',2I10,F12.3) +C6001 FORMAT('N,K,CBTS = ',2I10,F12.3) DO K=1,KC DO LL=1,NCBW NSID=NCSERW(LL,M) @@ -610,7 +610,7 @@ C ENDIF ENDDO ENDDO - 6002 FORMAT('N,K,CBTN = ',2I10,F12.3) +C6002 FORMAT('N,K,CBTN = ',2I10,F12.3) C C ** MODIFIY VERTICAL MASS DIFFUSION IF ANTI-DIFFUSIVE ADVECTIVE C ** IS TURNED OFF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for index afcc29cf1..c7e0e4ae1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for @@ -514,7 +514,7 @@ C ENDDO ENDDO C - 1069 FORMAT(I8,10E13.5) +C1069 FORMAT(I8,10E13.5) C DO K=1,KS DO L=2,LA @@ -779,7 +779,7 @@ C ENDDO ENDDO C - 6001 FORMAT('N,K,CBTS = ',2I10,F12.3) +C6001 FORMAT('N,K,CBTS = ',2I10,F12.3) C C----------------------------------------------------------------------C C @@ -901,7 +901,7 @@ C ENDDO ENDDO C - 6002 FORMAT('N,K,CBTN = ',2I10,F12.3) +C6002 FORMAT('N,K,CBTN = ',2I10,F12.3) C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for index 675dea6ae..254aaab33 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for @@ -61,7 +61,7 @@ C USTAR=SQRT(TAUB) IF(USTAR.LT.WS) CSNDEQC=0. ENDIF - 600 FORMAT(10E12.4) +C 600 FORMAT(10E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for index d03bf2a81..3401f62c9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for @@ -25,7 +25,7 @@ C CLOSE(1) 99 FORMAT(A80) 100 FORMAT(I10) - 101 FORMAT(2I10) +C 101 FORMAT(2I10) 200 FORMAT(2I5,1X,2D12.6,F12.6) 250 FORMAT(12F10.6) RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for index cefc85250..1d8f71136 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for @@ -1492,15 +1492,15 @@ C READ(1)TIME,SALMAX,SALMIN C READ(1)IB16VAL C TMPVAL=(SALMAX-SALMIN)/RSCALE C - 100 FORMAT(A80) +C 100 FORMAT(A80) 101 FORMAT(8I6) - 102 FORMAT(8I4) +C 102 FORMAT(8I4) 111 FORMAT(10E12.4) - 201 FORMAT(//,' CHECK 2D 8 BIT VARIABLE',/) - 202 FORMAT(//,' CHECK 3D 8 BIT VARIABLE',/) - 203 FORMAT(//,' CHECK 2D 16 BIT VARIABLE',/) - 204 FORMAT(//,' CHECK 3D 16 BIT VARIABLE',/) - 205 FORMAT(8F8.2) +C 201 FORMAT(//,' CHECK 2D 8 BIT VARIABLE',/) +C 202 FORMAT(//,' CHECK 3D 8 BIT VARIABLE',/) +C 203 FORMAT(//,' CHECK 2D 16 BIT VARIABLE',/) +C 204 FORMAT(//,' CHECK 3D 16 BIT VARIABLE',/) +C 205 FORMAT(8F8.2) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index fe00eb5fe..abdd05c4e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -628,7 +628,7 @@ CX IF(ISDRY.EQ.3.OR.ISDRY.EQ.4) CALL CALPUV6(ISTL) !7 MOVED TO 8 C IF(ISDRY.EQ.3.OR.ISDRY.EQ.4) CALL CALPUV8(ISTL) CJH ENDIF C - 5555 CONTINUE +C5555 CONTINUE C TPUV=TPUV+SECNDS(T1TMP) C @@ -1678,11 +1678,11 @@ C**********************************************************************C C C ** TIME LOOP COMPLETED C - 1001 THDMT=THDMT+SECNDS(TTMP) +C1001 THDMT=THDMT+SECNDS(TTMP) C C**********************************************************************C C - 2000 CONTINUE +C2000 CONTINUE C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index b7d772630..1f70804ba 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -596,7 +596,7 @@ C----------------------------------------------------------------------C C C ** REENTER HERE FOR TWO TIME LEVEL LOOP C - 500 CONTINUE +C 500 CONTINUE C C**********************************************************************C C @@ -1427,9 +1427,9 @@ C ENDIF C 3678 FORMAT(2I6,4F13.3) - 3679 FORMAT(12x,4F13.3) - 3680 FORMAT(12x,6F13.5) - 3681 FORMAT(12X,5E13.4,F13.5) +C3679 FORMAT(12x,4F13.3) +C3680 FORMAT(12x,6F13.5) +C3681 FORMAT(12X,5E13.4,F13.5) 3677 FORMAT('CORNER',2I5,5E14.5) 3676 FORMAT(6X,2I5,5E14.5) 3675 FORMAT(F11.3,I6,' TIME IN DAYS AND NUMBER OF CORNERS') @@ -1954,7 +1954,7 @@ C UNNECESSARY DUPLICATION C *** EE END BLOCK C**********************************************************************C C - 2000 CONTINUE +C2000 CONTINUE C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index fb72436a3..00415d4e8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -2153,12 +2153,12 @@ C 6 FORMAT (120I1) C 66 FORMAT (I3,2X,120I1) PMC 66 FORMAT (A5,120I1) - 9 FORMAT (/,' DEPTH ARRAY:',//) +C 9 FORMAT (/,' DEPTH ARRAY:',//) 16 FORMAT (1X,120I1) C 166 FORMAT (1X,I3,2X,120I1) PMC 166 FORMAT (1X,A5,120I1) - 7 FORMAT (30F4.1) - 17 FORMAT(1X,30F4.1) +C 7 FORMAT (30F4.1) +C 17 FORMAT(1X,30F4.1) C C ** READ CURVILINEAR-ORTHOGONAL OR VARIABLE CELL DATA FROM FILE C ** DXDY.INP @@ -2473,7 +2473,7 @@ C ENDIF CLOSE(1) ENDIF - 339 FORMAT(2I5,6F14.5) +C 339 FORMAT(2I5,6F14.5) C C ** OPEN FILE FBODY.INP TO READ IN SPATIALLY VARYING BODY FORCES C @@ -3572,8 +3572,8 @@ C CLOSE(1) ENDIF ENDIF - 19 FORMAT (/,' INITIAL BUOYANCY ARRAY:',//) - 907 FORMAT(12F6.2) +C 19 FORMAT (/,' INITIAL BUOYANCY ARRAY:',//) +C 907 FORMAT(12F6.2) C C ** READ IN OPEN BOUNDARY SURFACE ELEVATION TIME SERIES FROM THE C ** FILE PSER.INP @@ -3600,7 +3600,7 @@ C ENDDO CLOSE(1) ENDIF - 6776 FORMAT(A20) +C6776 FORMAT(A20) C C ** READ IN VOLUMETRIC SOURCE OR RIVER INFLOW TIME SERIES FROM THE C ** FILE QSER.INP @@ -3647,7 +3647,7 @@ C ENDDO CLOSE(1) ENDIF - 2222 FORMAT(2I5,F12.7,F12.4) +C2222 FORMAT(2I5,F12.7,F12.4) C C ** READ IN FLOW WITHDRAWL-RETURN FLOW AND CONCENTRATION RISE C ** TIME SERIES FROM THE FILE QWRS.INP @@ -4020,7 +4020,7 @@ C C C ** CHECK SEDIMENT SERIES C - 2001 FORMAT(3I5,2F12.5) +C2001 FORMAT(3I5,2F12.5) !{GeoSR, YSSONG, TOXIC, 101030 @@ -4662,7 +4662,7 @@ C WRITE(8,801) 801 FORMAT(' READ ERROR FOR FILE CELL.INP ') STOP - 820 WRITE(6,821) +C 820 WRITE(6,821) WRITE(8,821) 821 FORMAT(' READ ERROR FOR FILE DEPTH.INP ') STOP @@ -4766,7 +4766,7 @@ C WRITE(8,961) 961 FORMAT(' READ ERROR FOR FILE SFBSER.INP ') STOP - 970 WRITE(6,971) +C 970 WRITE(6,971) WRITE(8,971) 971 FORMAT(' READ ERROR FOR FILE TIDASM.INP ') STOP @@ -4831,6 +4831,6 @@ C ENDIF ENDDO PARSE_LOGICAL=.FALSE. - 900 FORMAT(L1) - 999 RETURN +C 900 FORMAT(L1) +C 999 RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for index 9f20be74d..3a0c88e51 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for @@ -1009,7 +1009,7 @@ C IF(ISENT(NJP).EQ.0) DRMAJ=MAX(DRMAJSA,DRMAJFA) IF(DRMAJSA.GT.DRMAJFA) ISHEAR=1 IF(DRMAJFA.GT.DRMAJSA) IFORCE=1 - 110 FORMAT(2I6,5E14.5) +C 110 FORMAT(2I6,5E14.5) C C ++ ADVANCE MASS C @@ -1716,7 +1716,7 @@ C 1111 FORMAT(I5,10E14.5) 899 FORMAT(' JPENT ',I5,F12.6,12E12.4) 898 FORMAT(' FINAL JPENT ',I5,F12.6,12E12.4) - 100 FORMAT(120X) +C 100 FORMAT(120X) 101 FORMAT(2I6,15E12.4) 104 FORMAT(15E12.4) 111 FORMAT(' NJ NE TIME XJ YJ ', @@ -1732,7 +1732,7 @@ C 134 FORMAT(' BEGIN JET/PLUME NJP,TIME = ',I6,F12.5) 135 FORMAT(' END JET/PLUME NJP,TIME,KFLAG,KEFFJP,KQJP,QVJET,QVJTOT', & ' = ',I6,F13.5,3I4,2E12.4) - 600 FORMAT(' ELEMENT, # INTERATIONS = ',2I6) +C 600 FORMAT(' ELEMENT, # INTERATIONS = ',2I6) 601 FORMAT(' MAXIMUM ITERATIONS EXCEEDED NE,NI = ',2I6,' !!!!!!!!') 602 FORMAT(' JET/PLUME BNDRY PEN SURF NJ,NE,NI,Z,ZS = ',3I6,2F10.2) 6020 FORMAT(' JP BDRY PEN SURF NJ,NE,NI,Z,ZS= ',3I5,2F8.2) @@ -1744,7 +1744,7 @@ C 6050 FORMAT(' JP CTLN PEN SURF NJ,NE,NI,Z,ZS= ',3I5,2F8.2) 606 FORMAT(' JET/PLUME CTRLN PEN BOTT NJ,NE,NI,Z,ZB = ',3I6,2F10.2) 6060 FORMAT(' JP CTLN PEN BOTT NJ,NE,NI,Z,ZS= ',3I5,2F8.2) - 888 FORMAT(A80,/) +C 888 FORMAT(A80,/) 620 FORMAT('NJ,NE,NI,IT,DS,DSO,DF,DFO = ',4I6,6E13.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for index 81b21f29e..ba5bd8d95 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for @@ -151,7 +151,7 @@ C ENDIF ENDIF 1001 FORMAT(2I5,10(1X,E12.4)) - 1002 FORMAT(3I4,10(1X,E9.2)) +C1002 FORMAT(3I4,10(1X,E9.2)) 1991 FORMAT(2I5,12F8.3) 1992 FORMAT(10X,12F8.3) 1111 FORMAT(' NEG DEPTH AT CELL CENTER') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for index cfff51ee4..ba808e900 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for @@ -1351,12 +1351,12 @@ C ENDIF ENDIF ENDIF - 500 FORMAT(5I5) +C 500 FORMAT(5I5) 501 FORMAT(72I4) 502 FORMAT(I5,F10.4) - 505 FORMAT(8F10.5) - 506 FORMAT(I5,2X,F10.5,5X,I5) - 510 FORMAT(2I5,4(2X,F10.5)) +C 505 FORMAT(8F10.5) +C 506 FORMAT(I5,2X,F10.5,5X,I5) +C 510 FORMAT(2I5,4(2X,F10.5)) 520 FORMAT('IAD = ',I5,' JAD = ',I5//) 521 FORMAT('SALMAX = ',E12.4,' SALMIN = ',E12.4/) 522 FORMAT('TEMMAX = ',E12.4,' TEMMIN = ',E12.4/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for index dd7d831bd..4939af430 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for @@ -12,14 +12,14 @@ C 41 FORMAT (' GLOBAL SQUARED ERROR',//) WRITE(7,43)ERRMAX,ERRMIN 43 FORMAT('ERRMAX =',3X,E12.4,5X,'ERRMIN =',3X,E12.4) - 20 FORMAT (1X,I5,3X,10E12.4) +C 20 FORMAT (1X,I5,3X,10E12.4) WRITE(7,40)RP WRITE (7,42) 42 FORMAT (' ITERATIONS TO CONVERGENCE',//) WRITE(7,44)ITRMAX,ITRMIN 44 FORMAT('ITRMAX =',I5,5X,'ITRMIN =',I5) - 21 FORMAT (1X,I5,5X,10I10) - 30 FORMAT (10E12.4) +C 21 FORMAT (1X,I5,5X,10I10) +C 30 FORMAT (10E12.4) C C ** OUTPUT HARMONIC ANALYSIS C @@ -46,13 +46,13 @@ C C C ** PRINTED OUTPUT OF P,U,AND V AMPLITUDES C - 72 FORMAT(3I5,4(3X,E12.4)) +C 72 FORMAT(3I5,4(3X,E12.4)) C C ** OUTPUT VECTOR POTENTIAL TRANSPORT VELOCITY C - 1458 FORMAT(1H1,' X VECTOR POTENTIAL TRANSPORT VEL, M/S, LAYER',I5,//) - 1459 FORMAT(1H1,' Y VECTOR POTENTIAL TRANSPORT VEL, M/S, LAYER',I5,//) - 100 CONTINUE +C1458 FORMAT(1H1,' X VECTOR POTENTIAL TRANSPORT VEL, M/S, LAYER',I5,//) +C1459 FORMAT(1H1,' Y VECTOR POTENTIAL TRANSPORT VEL, M/S, LAYER',I5,//) +C 100 CONTINUE RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for index ae329f9cc..5eb811c00 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for @@ -47,7 +47,7 @@ C ENDDO ENDIF 10 FORMAT (5X,E12.4,5X,A1,5X,E12.4) - 11 FORMAT (////) +C 11 FORMAT (////) WRITE(7,12) 12 FORMAT(1H1) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for index 8e7a95c2d..22de6780b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for @@ -727,8 +727,8 @@ C 201 FORMAT(' L,I(ROW),J(COL),QX(I,J,K),K=1,KC ',/) 202 FORMAT(' L,I(ROW),J(COL),QY(I,J,K),K=1,KC ',/) 203 FORMAT(' L,I(ROW),J(COL),QZ(I,J,K),K=1,KS ',/) - 204 FORMAT(' L,I(ROW),J(COL),AX(I,J,K),K=1,KC ',/) - 205 FORMAT(' L,I(ROW),J(COL),AY(I,J,K),K=1,KC ',/) +C 204 FORMAT(' L,I(ROW),J(COL),AX(I,J,K),K=1,KC ',/) +C 205 FORMAT(' L,I(ROW),J(COL),AY(I,J,K),K=1,KC ',/) 206 FORMAT(' L,I(ROW),J(COL),AZ(I,J,K),K=1,KS ',/) 207 FORMAT(' L,I(ROW),J(COL),SELS(I,J),SELE(I,J),DSEL(I,J) ',/) 208 FORMAT(' L,I(ROW),J(COL),SAL(I,J,K),K=1,KC ',/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for index 605bda5f1..d4c522125 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READOIL.for @@ -142,7 +142,7 @@ CLOSE(21) RETURN - 999 STOP 'OIL.INFO READING ERROR!' +C 999 STOP 'OIL.INFO READING ERROR!' END SUBROUTINE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS2.for index 8a217b329..12c76e33e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS2.for @@ -34,7 +34,7 @@ C ENDIF ! 2014.09.14. YSSONG, COMMENTOUT ENDIF 8999 FORMAT('LOADING POINT :',2(F12.3,1X),2X,'(',I4,',',I4,')') - 8998 FORMAT('LOADING POINT :',2(F12.3,1X)) !,2X,'(',I4,',',I4,')') +C8998 FORMAT('LOADING POINT :',2(F12.3,1X)) !,2X,'(',I4,',',I4,')') CLOSE(21) RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for index e994b6d91..f03326241 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for @@ -208,8 +208,8 @@ C ENDDO ENDIF CLOSE(1) - 6666 FORMAT(3I10,F12.6) - 6667 FORMAT(7I5,2X,E12.4,2X,E12.4) +C6666 FORMAT(3I10,F12.6) +C6667 FORMAT(7I5,2X,E12.4,2X,E12.4) DO K=1,KC SAL(1,K)=0. TEM(1,K)=0. @@ -539,8 +539,8 @@ C *** DSLLC END BLOCK C GOTO 3000 - 101 FORMAT(I5) - 102 FORMAT(3I5,12F8.2) +C 101 FORMAT(I5) +C 102 FORMAT(3I5,12F8.2) C C ** WRITE READ ERRORS ON RESTART C @@ -614,8 +614,8 @@ C STOP 600 FORMAT(2X,'I,J,BELVOLD,BELVNEW',2I5,2F12.2) - 906 FORMAT(5E15.7) - 907 FORMAT(12E12.4) +C 906 FORMAT(5E15.7) +C 907 FORMAT(12E12.4) 908 FORMAT(12I10) 2000 FORMAT(' READ ERROR ON FILE RESTART.INP ERR 1000') 2001 FORMAT(' READ ERROR ON FILE RESTART.INP ERR 1001 L =',I6) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for index 6bcba021b..71446d139 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for @@ -286,8 +286,8 @@ C 1001 FORMAT(' READ ERROR ON FILE RESTART.INP ') STOP 1002 CONTINUE - 907 FORMAT(12E12.4) - 908 FORMAT(12I10) +C 907 FORMAT(12E12.4) +C 908 FORMAT(12I10) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for index b70ffc2fe..ff0f1e494 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for @@ -201,8 +201,8 @@ C 1001 FORMAT(' READ ERROR ON FILE RESTART.INP ') STOP 1002 CONTINUE - 906 FORMAT(4E15.7) - 907 FORMAT(12E12.4) +C 906 FORMAT(4E15.7) +C 907 FORMAT(12E12.4) 908 FORMAT(12I10) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for index 621fcaff0..3466aae81 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for @@ -480,7 +480,7 @@ C ENDDO CLOSE(1) ENDIF - 339 FORMAT(2I5,6F14.5) +C 339 FORMAT(2I5,6F14.5) 101 FORMAT(2I5,18E13.5) 102 FORMAT(10X,18E13.5) 111 FORMAT(' IL JL SEDBT(K=1,KB)') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for index 9049a4f41..7cb983ba2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for @@ -1359,12 +1359,12 @@ C ENDIF ENDIF ENDIF - 500 FORMAT(5I5) +C 500 FORMAT(5I5) 501 FORMAT(72I4) 502 FORMAT(I5,F10.4) - 505 FORMAT(8F10.5) - 506 FORMAT(I5,2X,F10.5,5X,I5) - 510 FORMAT(2I5,4(2X,F10.5)) +C 505 FORMAT(8F10.5) +C 506 FORMAT(I5,2X,F10.5,5X,I5) +C 510 FORMAT(2I5,4(2X,F10.5)) 520 FORMAT('IAD = ',I5,' JAD = ',I5//) 521 FORMAT('RSALMAX = ',E12.4,' RSALMIN = ',E12.4/) 522 FORMAT('RTEMMAX = ',E12.4,' RTEMMIN = ',E12.4/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for index 11b180c10..c46f8c006 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for @@ -307,7 +307,7 @@ C 200 FORMAT(2I5,1X,6E14.6) 250 FORMAT(12E12.4) 400 FORMAT(1X,6E14.6) - 420 FORMAT(1X,13E11.3) +C 420 FORMAT(1X,13E11.3) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for index 752df6068..03c3d33fd 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for @@ -70,7 +70,7 @@ C 50 FORMAT(A79) 52 FORMAT(I7, 1X, A3) 60 FORMAT(/, A24, I5, A24) - 84 FORMAT(3I5, 20F8.4, F8.2) +C 84 FORMAT(3I5, 20F8.4, F8.2) 90 FORMAT(2I5, 18E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for index ba4cc9686..922db99bd 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for @@ -40,7 +40,7 @@ C ENDDO CLOSE(1) ENDIF - 90 FORMAT(I5, 18E12.4) +C 90 FORMAT(I5, 18E12.4) 999 FORMAT(1X) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for index b775c64ef..db6b8871f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for @@ -35,7 +35,7 @@ C CLOSE(10) 99 FORMAT(A80) 100 FORMAT(I10,F12.4) - 101 FORMAT(2I10) +C 101 FORMAT(2I10) 200 FORMAT(2I5,1X,6E14.6) 250 FORMAT(12E12.4) RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for index aab1728aa..6012c6b92 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for @@ -67,7 +67,7 @@ C 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I8, 100F8.3) ! Note, this might need some attention - 52 FORMAT(I7, 1X, A3) +C 52 FORMAT(I7, 1X, A3) 60 FORMAT(/, A24, F5.1, A24) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for index 00e1dcb1f..63b5a4939 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for @@ -114,8 +114,8 @@ C 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I8, 10F8.3) - 52 FORMAT(I7, 1X, A3) - 60 FORMAT(/, A24, I5, A24) +C 52 FORMAT(I7, 1X, A3) +C 60 FORMAT(/, A24, I5, A24) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index e02baa9f8..852e3d6d6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -321,9 +321,9 @@ C PMC IF(MOD(IWQTSDT,IWQDT).NE.0) C PMC & STOP 'ERROR!! IWQTSDT SHOULD BE MULTIPLE OF IWQDT' 999 FORMAT(1X) 90 FORMAT(A79) - 91 FORMAT(10I8) - 92 FORMAT(10F8.4) - 93 FORMAT(I8,3F8.4) +C 91 FORMAT(10I8) +C 92 FORMAT(10F8.4) +C 93 FORMAT(I8,3F8.4) 94 FORMAT(2I5, 13I5, /, 10X, 9I5) 95 FORMAT(A254) 80 FORMAT(A50) @@ -802,7 +802,7 @@ C IF(WTEMP.GT.WQTMD2)THEN WQTDGP(M) = EXP(-WQKG2P*(WTEMP-WQTMP2)*(WTEMP-WQTMP2) ) ENDIF - 555 FORMAT(F7.2,4E12.4) +C 555 FORMAT(F7.2,4E12.4) WQTDRC(M) = EXP( WQKTBC*(WTEMP-WQTRC) ) WQTDRD(M) = EXP( WQKTBD*(WTEMP-WQTRD) ) WQTDRG(M) = EXP( WQKTBG*(WTEMP-WQTRG) ) @@ -1707,12 +1707,12 @@ C *** MG/L FOR 1-19, TAM-MOLES/L, AND FCB-MPN/L ENDIF 294 FORMAT(2I4,2I3, 7F8.3, /, 14X, 7F8.3, /, 14X, 8F8.3) 295 FORMAT(44X, A50) - 96 FORMAT(2I5, 13I5, /, 10X, 8I5) +C 96 FORMAT(2I5, 13I5, /, 10X, 8I5) 969 FORMAT(2I4,1X,21I3) 970 FORMAT(1X,21I3) 97 FORMAT(2I4, 6F8.3, /, 8X, 7F8.3, /, 8X, 8F8.3) - 98 FORMAT(6F8.4, /, 7F8.4, /, 8F8.4) - 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) +C 98 FORMAT(6F8.4, /, 7F8.4, /, 8F8.4) +C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) 21 FORMAT(A27, 1P, 4E11.3) 981 FORMAT(A27, 1P, 3E11.3) 23 FORMAT(A46, I5) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for index 58be588e7..aa634ec14 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for @@ -130,8 +130,7 @@ C 801 CONTINUE 1 FORMAT(120X) 601 FORMAT(' READ ERROR WQ TIME SERIES, NWQ,NSER,MDATA = ',3I5) - 602 FORMAT(' READ OF FILES CWQSRNN.INP SUCCESSFUL'/) - +C 602 FORMAT(' READ OF FILES CWQSRNN.INP SUCCESSFUL'/) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for index f0f701b70..71726f3fb 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for @@ -65,7 +65,7 @@ C 999 FORMAT(1X) 50 FORMAT(A79) - 52 FORMAT(I7, 1X, A3) +C 52 FORMAT(I7, 1X, A3) 60 FORMAT(/, A24, I5, A24) ! 84 FORMAT(3I5, 21E12.4) ! BUG -> EDITED BY GEOSR : JGCHO 2010.11.11 84 FORMAT(2I5,21E12.4) ! EDITED BY GEOSR : JGCHO 2010.11.11 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for index 9fe23b228..1571d0aea 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for @@ -82,7 +82,7 @@ C 901 CONTINUE 1 FORMAT(120X) 601 FORMAT(' READ ERROR WQPS TIME SERIES, NSER,MDATA = ',2I5) - 602 FORMAT(' READ OF FILE WQPSL.INP SUCCESSFUL'/) +C 602 FORMAT(' READ OF FILE WQPSL.INP SUCCESSFUL'/) 1000 CONTINUE C C ** INITIALIZE NULL SERIES LOADING TO ZERO diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for index 3c790e556..33a357eac 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for @@ -53,7 +53,7 @@ C ENDDO ENDIF ENDIF - 90 FORMAT(2I5, 21E12.4) +C 90 FORMAT(2I5, 21E12.4) 999 FORMAT(1X) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for index 40b4bfec0..66ba28244 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for @@ -58,7 +58,7 @@ C 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I3, 50F8.3) - 52 FORMAT(I7, 1X, A3) +C 52 FORMAT(I7, 1X, A3) 60 FORMAT(/, A24, F5.1, A24) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for index f8f99603b..6b9c45a32 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for @@ -560,9 +560,9 @@ C 100 FORMAT(I10,F12.4) 101 FORMAT(2I10) 200 FORMAT(2I5,1X,8E14.6) - 220 FORMAT(2I5,1X,13E11.3) +C 220 FORMAT(2I5,1X,13E11.3) 400 FORMAT(1X,8E14.6) - 420 FORMAT(1X,13E12.4) +C 420 FORMAT(1X,13E12.4) 250 FORMAT(12E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH.for index 6d66a6375..272475c9b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH.for @@ -80,7 +80,7 @@ C WRITE(1,9102)L,IL(L),JL(L),(SAL(L,K),K=1,KC) ENDDO CLOSE(1) - 6000 FORMAT(' COMPLE V1 SMOOTHING LAYER ',I5,' NSM = ',I5/) +C6000 FORMAT(' COMPLE V1 SMOOTHING LAYER ',I5,' NSM = ',I5/) 6001 FORMAT(' COMPLE V2 SMOOTHING LAYER ',I5,' NSM = ',I5/) 9101 FORMAT(I5) 9102 FORMAT(3I5,12F6.2) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for index 9cd57973a..dcd68b0b3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for @@ -32,10 +32,10 @@ RETURN - 10 FORMAT(A80) +C 10 FORMAT(A80) 20 WRITE(*,30)'GATECTL.INP' WRITE(8,30)'GATECTL.INP' 30 FORMAT(' READ ERROR IN FILE: GATECTL.INP ') STOP - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for index 5ea46f4c4..873d1c9e9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for @@ -22,10 +22,10 @@ RETURN - 10 FORMAT(A80) +C 10 FORMAT(A80) 20 WRITE(*,30)'MASK.INP' WRITE(8,30)'MASK.INP' 30 FORMAT(' READ ERROR IN FILE: GATECTL.INP ') STOP - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for index 3be1e4fc4..441cdd800 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for @@ -180,12 +180,12 @@ C PMC & STOP 'ERROR!! ISMTSDT SHOULD BE MULTIPLE OF IWQDT' 5100 FORMAT(A79) 5101 FORMAT(10I8) 5103 FORMAT(10F8.4) - 5104 FORMAT(I8, 3F8.4) +C5104 FORMAT(I8, 3F8.4) 50 FORMAT(A50) 51 FORMAT(A27, 3(F8.4,2X)) 52 FORMAT((A45, E10.4)) 53 FORMAT((A48, I10)) - 55 FORMAT(A31, 2I5) +C 55 FORMAT(A31, 2I5) 84 FORMAT(3(A26,F10.4,A5,/), 2(A26,I8,A10,/)) C C05 @@ -540,7 +540,7 @@ C & STOP 'ERROR!! SMFCR(I,1)+SMFCR(I,2)+SMFCR(I,3) SHOULD BE 1' ENDDO CLOSE(1) - 6666 FORMAT(A30) +C6666 FORMAT(A30) 998 FORMAT(80X) 5105 FORMAT(10F8.2) 54 FORMAT(I8, 10F8.3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for index 8ed31c079..e21360d48 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for @@ -402,7 +402,7 @@ C ** DIAGNOSTICS OF INITIALIZATION C TMP1=-999. C TMP2=-999. C - 2222 FORMAT(2I5,7E13.4) +C2222 FORMAT(2I5,7E13.4) C C ** SAVE OLD VALUES C @@ -730,7 +730,7 @@ C ENDIF C C**********************************************************************C - 869 FORMAT(' I,J,HGDH = ',2I5,F10.3) +C 869 FORMAT(' I,J,HGDH = ',2I5,F10.3) IF(IWRSP(1).LT.98)THEN !do not recalculate bed when SEDZLJ dynamics are active DO L=2,LA HBEDA(L)=0.0 @@ -831,7 +831,7 @@ C ENDDO ENDIF ENDIF - 8669 FORMAT('PA ERR ',I10,F10.5,8E14.6) +C8669 FORMAT('PA ERR ',I10,F10.5,8E14.6) C C ** UPDATE TOP BED LAYER THICKNESS AND VOID RATIO C ** FOR DEPOSITION-RESUSPENSION STEP @@ -1028,7 +1028,7 @@ C 2345 FORMAT('NEG DEPTH DUE TO MORPH CHANGE', 2I5,12F12.5) 2347 FORMAT(' ', 2I5,12F12.5) 2348 FORMAT('WITHIN TOLERANCE MORPH CHANGE NEG DEPTH',F10.5,2I5,5F12.5) - 2346 FORMAT('MORP ERR ',2I5,6E15.6) +C2346 FORMAT('MORP ERR ',2I5,6E15.6) 1993 FORMAT(2I6,4E14.6) C C ++ ADJUST CONCENTRATIONS OF TRANSPORT VARIABLES IN RESPONSE TO @@ -1115,7 +1115,7 @@ C C C**********************************************************************C C - 8800 FORMAT(I5,8E14.5) +C8800 FORMAT(I5,8E14.5) CLOSE(1) CLOSE(11) CLOSE(21) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for index 5a233a149..3cba42624 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for @@ -131,7 +131,7 @@ C WRITE(8,1949)N,IACTALL ENDIF 1949 FORMAT(' N, # ACTIVE 2 GRID FLOWS = ',2I8) - 1948 FORMAT(I5,3E12.4) +C1948 FORMAT(I5,3E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VSFP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VSFP.for index d854b9ebb..8bdc7e0a0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VSFP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VSFP.for @@ -271,7 +271,7 @@ C CLOSE(1) ENDIF ENDDO - 101 FORMAT(' INSTANTANEOUS VERTICAL SCALAR FIELD PROFILES') +C 101 FORMAT(' INSTANTANEOUS VERTICAL SCALAR FIELD PROFILES') 102 FORMAT(/) 103 FORMAT(' TIME = ',F12.4,' N = ',I8,' I,J = ',2I4, & ' H = ',F10.2) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP4.for index 6edeaff75..b40f2fcea 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP4.for @@ -266,7 +266,7 @@ C 1014 FORMAT(2E10.3,2I5) 1015 FORMAT(I5) 1016 FORMAT(4(2F10.5)) - 1017 FORMAT(16I5) +C1017 FORMAT(16I5) C C ** WRITE ADVECTIVE TRANSPORT FILE WASPD.OUT C ** FILE WASPD.OUT IS CONSISTENT WITH DATA GROUP D.1 SPECIFICATIONS @@ -598,13 +598,13 @@ C CLOSE(95) 901 FORMAT(2I5,E12.4,4I5,E12.4) 902 FORMAT(I5,2X,3E12.4,2I5) - 903 FORMAT(3E12.4,2I5) +C 903 FORMAT(3E12.4,2I5) 904 FORMAT(I5,2X,E12.4,10I5) - 905 FORMAT(I5) - 906 FORMAT(5E12.4) +C 905 FORMAT(I5) +C 906 FORMAT(5E12.4) 941 FORMAT(2I5,E12.4,4I5,E12.4) 942 FORMAT(3E12.4,2I5) - 943 FORMAT(3E12.4,2I5) +C 943 FORMAT(3E12.4,2I5) 944 FORMAT(E12.4,10I5) 945 FORMAT(I5) 946 FORMAT(5E12.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for index 5ae8c1f16..bacd14670 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for @@ -785,18 +785,18 @@ C ENDDO CLOSE(90) CLOSE(94) - 901 FORMAT(2I5,E12.4,4I5,E12.4) +C 901 FORMAT(2I5,E12.4,4I5,E12.4) 902 FORMAT(I5,2X,3F20.8,3I5) - 903 FORMAT(3E12.4,2I5) +C 903 FORMAT(3E12.4,2I5) 904 FORMAT(I5,2X,F20.8,10I5) - 905 FORMAT(I5) - 906 FORMAT(5E12.4) +C 905 FORMAT(I5) +C 906 FORMAT(5E12.4) 941 FORMAT(2I5,3F20.8,I5) - 942 FORMAT(3E12.4,2I5) - 943 FORMAT(3E12.4,2I5) +C 942 FORMAT(3E12.4,2I5) +C 943 FORMAT(3E12.4,2I5) 944 FORMAT(I5,2X,F20.8,10I5) 9440 FORMAT(4F20.8) - 945 FORMAT(I5) +C 945 FORMAT(I5) 946 FORMAT(4F20.8) JSWASP=0 RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for index 1cf653d3e..b490ffece 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for @@ -601,7 +601,7 @@ C CLOSE(92) ENDIF 2020 FORMAT(2I5,A12,' DATA GROUP D: FLOWS') - 2021 FORMAT(I5,2E10.3,' DATA BLOCK D.1 ADVECTIVE FLOWS') +C2021 FORMAT(I5,2E10.3,' DATA BLOCK D.1 ADVECTIVE FLOWS') 2022 FORMAT(I5,2E10.3,' DATA BLOCK D.2 PORE WATER FLOWS') 2023 FORMAT(I5,2E10.3,' DATA BLOCK D.3 SEDIMENT #1 TRANSPORT FIELD') 2024 FORMAT(I5,2E10.3,' DATA BLOCK D.4 SEDIMENT #2 TRANSPORT FIELD') @@ -1040,16 +1040,16 @@ C IF(IQOPT.EQ.4) CLOSE(95) 901 FORMAT(2I5,E12.4,4I5,E12.4) 902 FORMAT(I5,2X,3F20.8,3I5) - 903 FORMAT(3E12.4,2I5) +C 903 FORMAT(3E12.4,2I5) 904 FORMAT(I5,2X,F20.8,10I5) 905 FORMAT(I5) - 906 FORMAT(5E12.4) +C 906 FORMAT(5E12.4) 941 FORMAT(2I5,3F20.8,I5) - 942 FORMAT(3E12.4,2I5) - 943 FORMAT(3E12.4,2I5) +C 942 FORMAT(3E12.4,2I5) +C 943 FORMAT(3E12.4,2I5) 944 FORMAT(I5,2X,F20.8,10I5) 9440 FORMAT(4F20.8) - 945 FORMAT(I5) +C 945 FORMAT(I5) 946 FORMAT(4E17.9) JSWASP=0 RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for index 592002243..3d5972373 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for @@ -576,8 +576,8 @@ C C C C - 6999 FORMAT(9I5,F5.1) - 6996 FORMAT(9I5,F5.1) +C6999 FORMAT(9I5,F5.1) +C6996 FORMAT(9I5,F5.1) WRITE(92,2030) LL DO L=1,LL,4 WRITE(92,1024) QTMP(L), LUTMP(L), LDTMP(L), @@ -634,7 +634,7 @@ C CLOSE(92) ENDIF 2020 FORMAT(2I5,A12,' DATA GROUP D: FLOWS') - 2021 FORMAT(1P,I5,2E10.3,' DATA BLOCK D.1 ADVECTIVE FLOWS') +C2021 FORMAT(1P,I5,2E10.3,' DATA BLOCK D.1 ADVECTIVE FLOWS') 2022 FORMAT(1P,I5,2E10.3,' DATA BLOCK D.2 PORE WATER FLOWS') 2023 FORMAT(1P,I5,2E10.3,' DATA BLOCK D.3 SED. #1 TRANSPORT FIELD') 2024 FORMAT(1P,I5,2E10.3,' DATA BLOCK D.4 SED. #2 TRANSPORT FIELD') @@ -1106,16 +1106,16 @@ C IF(IQOPT.EQ.4) CLOSE(95) 901 FORMAT(2I5,E12.5,4I5,E12.5) 902 FORMAT(I5,2X,3F20.8,3I5) - 903 FORMAT(3E12.5,2I5) +C 903 FORMAT(3E12.5,2I5) 904 FORMAT(I5,2X,F20.8,10I5) 905 FORMAT(I5) - 906 FORMAT(5E12.5) +C 906 FORMAT(5E12.5) 941 FORMAT(2I5,3F20.8,I5) - 942 FORMAT(3E12.5,2I5) - 943 FORMAT(3E12.5,2I5) +C 942 FORMAT(3E12.5,2I5) +C 943 FORMAT(3E12.5,2I5) 944 FORMAT(I5,2X,F20.8,10I5) 9440 FORMAT(4F20.8) - 945 FORMAT(I5) +C 945 FORMAT(I5) 946 FORMAT(4E17.9) 9946 FORMAT(3E17.9,I5) 9941 FORMAT(2I5,' !',3I5,3X,A3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for index 90811026b..eda03fe92 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for @@ -644,8 +644,8 @@ C qtmp array holds the horizontal area of each cell: END DO END IF C - 6999 format(9i5,f5.1) - 6996 format(9i5,f5.1) +C6999 format(9i5,f5.1) +C6996 format(9i5,f5.1) C WRITE(92,2030) LL DO L=1,LL,4 @@ -692,7 +692,7 @@ C add system bypass array to bottom of data group D: CLOSE(92) END IF 2020 format(2i5,a12,' Data Group D: Flows') - 2021 FORMAT(1p,I5,2e10.3,' Data Block D.1 Advective Flows') +C2021 FORMAT(1p,I5,2e10.3,' Data Block D.1 Advective Flows') 2022 FORMAT(1p,I5,2e10.3,' Data Block D.2 Pore Water Flows') 2023 FORMAT(1p,I5,2e10.3,' Data Block D.3 Sed. #1 Transport Field') 2024 FORMAT(1p,I5,2e10.3,' Data Block D.4 Sed. #2 Transport Field') @@ -1275,16 +1275,16 @@ C----------------------------------------------------------------------C C 901 FORMAT(2I5,E12.5,4I5,E12.5) 902 FORMAT(I5,2X,3F20.8,3I5) - 903 FORMAT(3E12.5,2I5) +C 903 FORMAT(3E12.5,2I5) 904 FORMAT(I5,2X,F20.8,10I5) 905 FORMAT(I5) - 906 FORMAT(5E12.5) +C 906 FORMAT(5E12.5) 941 FORMAT(3I5,3F20.5,I5) - 942 FORMAT(3E12.5,2I5) - 943 FORMAT(3E12.5,2I5) +C 942 FORMAT(3E12.5,2I5) +C 943 FORMAT(3E12.5,2I5) 944 FORMAT(I5,2X,F20.8,10I5) 9440 FORMAT(4F20.8) - 945 FORMAT(I5) +C 945 FORMAT(I5) 946 FORMAT(4E17.9) 9946 FORMAT(3e17.9,I5) 9941 FORMAT(2I5,' !',3i5,3x,a3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for index a9688751e..fbd6ae3f0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for @@ -195,13 +195,13 @@ C STOP 1083 WRITE(6,1093) NWVDAT STOP - 1084 WRITE(6,1094) IWVH +C1084 WRITE(6,1094) IWVH STOP 1 FORMAT(120X) 1091 FORMAT(' READ ERROR ON FILE WAVE.INP , HEADER') 1092 FORMAT(' READ ERROR ON FILE WAVE.INP , 1ST DATA') 1093 FORMAT(' READ ERROR ON FILE WAVE.INP , 2ND DATA, NWV = ',I5) - 1094 FORMAT(' READ ERROR ON FILE WAVE.INP , 3RD DATA, NWV = ',I5) +C1094 FORMAT(' READ ERROR ON FILE WAVE.INP , 3RD DATA, NWV = ',I5) 111 FORMAT(2E14.4) 400 CONTINUE DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVESXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVESXY.for index d635a9f4e..f4a74a22e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVESXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVESXY.for @@ -165,13 +165,13 @@ C STOP 1083 WRITE(6,1093) NWV STOP - 1084 WRITE(6,1094) NWV +C1084 WRITE(6,1094) NWV STOP 1 FORMAT(120X) 1091 FORMAT(' READ ERROR ON FILE WAVE.INP , HEADER') 1092 FORMAT(' READ ERROR ON FILE WAVE.INP , 1ST DATA') 1093 FORMAT(' READ ERROR ON FILE WAVE.INP , 2ND DATA, NWV = ',I5) - 1094 FORMAT(' READ ERROR ON FILE WAVE.INP , 3RD DATA, NWV = ',I5) +C1094 FORMAT(' READ ERROR ON FILE WAVE.INP , 3RD DATA, NWV = ',I5) 111 FORMAT(2E14.4) C C ** INITIALIZE OR UPDATE WAVE FIELD diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for index bd2f3831e..8de4e921e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for @@ -55,7 +55,7 @@ C IWQT(L) = NINT( 4.*TWQ(L)+121.) C STOP 'ERROR!! INVALID WATER TEMPERATURE' ENDIF ENDDO - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) + 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT(/,'ERROR: TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) C DO L=2,LA @@ -202,7 +202,7 @@ C ELSE WQP19(L) = 0.0 ENDIF - 666 FORMAT(' K,IWQ,IZ,WQTDKR = ',3I5,E12.4) +C 666 FORMAT(' K,IWQ,IZ,WQTDKR = ',3I5,E12.4) ENDDO C C TRAPEZOIDAL SOLUTION OF KINETIC EQS: AFTER COMPUTING NEW VALUES, STORE @@ -283,9 +283,9 @@ C SPM C DIURNAL DO ANALYSIS C LIGHT EXTINCTION ANALYSIS C - 1111 FORMAT(I12,F10.4) - 1112 FORMAT(2I5,12F7.2) - 1113 FORMAT(2I5,12E12.4) - 1414 FORMAT(I12,11E12.4) +C1111 FORMAT(I12,F10.4) +C1112 FORMAT(2I5,12F7.2) +C1113 FORMAT(2I5,12E12.4) +C1414 FORMAT(I12,11E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for index 782002104..c096174ca 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for @@ -267,7 +267,7 @@ C ENDIF ENDDO ! *** DSLLC END BLOCK - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) + 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT('ERROR: TIME, L, I, J, K, TWQ(L),TEM(L,K) = ', & F10.5, 4I4, 2F10.4,/) @@ -1863,7 +1863,7 @@ C 1111 FORMAT(I12,F10.4) 1112 FORMAT(2I5,12F7.2) 1113 FORMAT(2I5,12E12.4) - 1414 FORMAT(I12,11E12.4) +C1414 FORMAT(I12,11E12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for index d90142b03..1e1eefabf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for @@ -78,7 +78,7 @@ C IWQT(L) = NINT( 4.*TWQ(L)+121.) C STOP 'ERROR!! INVALID WATER TEMPERATURE' ENDIF ENDDO - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) + 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT(/,'ERROR: TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) C C NOTE: MRM 04/29/99 ADDED ARRAYS TO KEEP TRACK OF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for index e1a1e2994..87f4f7152 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for @@ -159,7 +159,7 @@ C IWQT(L) = NINT( 4.*TWQ(L)+121.) C STOP 'ERROR!! INVALID WATER TEMPERATURE' ENDIF ENDDO - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) + 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT(/,'ERROR: TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) C C NOTE: MRM 04/29/99 ADDED ARRAYS TO KEEP TRACK OF @@ -868,7 +868,6 @@ C DO L=2,LA enddo ENDIF ENDDO -!} ELSE DO L=2,LA WQV(L,K,1)=WQVO(L,K,1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for index 6723dc6fa..3cef16fdd 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for @@ -123,7 +123,7 @@ C STOP 'ERROR!! INVALID WATER TEMPERATURE' ENDIF ENDDO C - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) + 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT(/,'ERROR ', & 'TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for index 102ce71e2..896cc114e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for @@ -490,7 +490,7 @@ C + TPWQSUM(LL,K),WQVSUM(LL,K,9),POPSUM(LL,K),WQVSUM(LL,K,10), ENDDO ENDDO C - 71 FORMAT(3I5,F11.5, 1P, 23E11.3) +C 71 FORMAT(3I5,F11.5, 1P, 23E11.3) C CLOSE(1) IF(ISWQAVG .GT. 0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for index 471aee25c..cd7825e9d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for @@ -715,9 +715,9 @@ C 112 FORMAT(20X,10F10.4) 101 FORMAT(F12.4,2I7,F12.3) 102 FORMAT(1X,2I6,10E13.5) - 103 FORMAT(' TXWF TXWC TXWP', - & ' DOCW POCW TXBF TXBC', - & ' TXBP (roc) DOCB POCB TXBPD (r)') +C 103 FORMAT(' TXWF TXWC TXWP', +C & ' DOCW POCW TXBF TXBC', +C & ' TXBP (roc) DOCB POCB TXBPD (r)') 121 FORMAT('DATA: OUTPUT TIME (DAYS), NTOX, NZONES, ', & 'AERAGING PERIOD (SECS)') 122 FORMAT('DATA: NT NZ TXWF TXWC TXWP', From 075e74aaed87196c6614cebece8fe123440a744f Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 16:31:53 +0100 Subject: [PATCH 09/77] Replace non-standard function SECNDS by SECOND The non-standard function SECNDS is replaced by SECOND throughout the source code. Since the alternative SECOND does not allow to provide a reference time, the time difference is obtained by subtracting the original reference value instead. For details on the non-standard call: https://gcc.gnu.org/onlinedocs/gcc-4.9.4/gfortran/SECNDS.html --- .../original_efdc_files/CALCONC.for | 4 +-- .../original_efdc_files/CALWQC.for | 9 +++--- .../original_efdc_files/CONGRAD.for | 4 +-- .../original_efdc_files/CONGRADC.for | 4 +-- .../original_efdc_files/HDMT.for | 30 +++++++++---------- .../original_efdc_files/HDMT2T.for | 28 ++++++++--------- .../original_efdc_files/WQ3D.for | 9 +++--- 7 files changed, 43 insertions(+), 45 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 0d8c0e454..644fbb125 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -175,7 +175,7 @@ C ENDDO ENDDO ENDIF - TTMP=SECNDS(0.0) + TTMP=SECOND() C IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).LT.4) & CALL CALTRAN (ISTL_,IS2TL_,1,1,SAL,SAL1) @@ -452,7 +452,7 @@ C CALL SSEDTOX(ISTL,IS2TL,1.0) IBALSTDT=1 ENDIF -C TVDIF=TVDIF+SECNDS(TTMP) +C TVDIF=TVDIF+TTMP-SECOND() ENDIF C C 888 FORMAT('N,IC,I,DTS,DT = ',3I5,2F12.8) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for index 2ca1cee4b..e621fe5b7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for @@ -23,7 +23,7 @@ C C ** UPDATED TIME SERIES CONCENTRATION BOUNDARY CONDITIONS C ** 3D ADVECTI0N TRANSPORT CALCULATION C - TTMP=SECNDS(0.0) + TTMP=SECOND() DO NW=1,NWQV IF(ISTRWQ(NW).EQ.1)THEN CALL CALTRAN(ISTL_,IS2TL_,8,NW,WQV(1,1,NW),WQV(1,1,NW)) @@ -33,8 +33,7 @@ C DO nsp=1,NXSP CALL CALTRAN(ISTL_,IS2TL_,8,nsp+NWQV,WQVX(1,1,nsp),WQVX(1,1,nsp)) ENDDO - - TWQADV=TWQADV+SECNDS(TTMP) + TWQADV=TWQADV+TTMP-SECOND() C C ** CALLS TO SOURCE-SINK CALCULATIONS C ** BYPASS OR INITIALIZE VERTICAL DIFFUSION CALCULATION @@ -43,7 +42,7 @@ C DO L=2,LA HWQI(L)=1./HWQ(L) ENDDO - TTMP=SECNDS(0.0) + TTMP=SECOND() C C ** VERTICAL DIFFUSION CALCULATION LEVEL 1 C @@ -499,7 +498,7 @@ C endif ENDDO ENDIF - TWQDIF=TWQDIF+SECNDS(TTMP) + TWQDIF=TWQDIF+TTMP-SECOND() 2000 CONTINUE RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for index 5e090ad8e..3ad5891df 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for @@ -22,7 +22,7 @@ C ENDIF ! *** DSLLC C - TTMP=SECNDS(0.0) + TTMP=SECOND() DO L=2,LA PNORTH(L)=P(LNC(L)) PSOUTH(L)=P(LSC(L)) @@ -120,7 +120,7 @@ C ENDDO ENDIF ! *** DSLLC END BLOCK - TCONG=TCONG+SECNDS(TTMP) + TCONG=TCONG+TTMP-SECOND() C 800 FORMAT(I5,8E13.4) 808 FORMAT(2I5,9E13.4) RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for index e3accd3d3..efae541c5 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for @@ -22,7 +22,7 @@ C ENDIF ! *** DSLLC C - TTMP=SECNDS(0.0) + TTMP=SECOND() DO L=2,LA PNORTH(L)=P(LNC(L)) PSOUTH(L)=P(LSC(L)) @@ -173,7 +173,7 @@ C ENDDO ENDIF ! *** DSLLC END BLOCK - TCONG=TCONG+SECNDS(TTMP) + TCONG=TCONG+TTMP-SECOND() 800 FORMAT(2I6,6E13.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index abdd05c4e..3574754c0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -466,7 +466,7 @@ C**********************************************************************C C C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALAVBOLD (ISTL) @@ -474,7 +474,7 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) ENDIF - TAVB=TAVB+SECNDS(T1TMP) + TAVB=TAVB+T1TMP-SECOND() C C**********************************************************************C C @@ -491,7 +491,7 @@ C**********************************************************************C C C ** CALCULATE EXPLICIT MOMENTUM EQUATION TERMS C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() C C NOTES ON VARIOUS VERSIONS OF CALEXP C @@ -537,7 +537,7 @@ C PMC IF(ISCDMA.EQ.5) CALL CALEXP2 (ISTL) C PMC IF(ISCDMA.EQ.6) CALL CALEXP2 (ISTL) C PMC IF(ISCDMA.EQ.9) CALL CALEXP9 (ISTL) C - TCEXP=TCEXP+SECNDS(T1TMP) + TCEXP=TCEXP+T1TMP-SECOND() C C**********************************************************************C C @@ -554,7 +554,7 @@ C**********************************************************************C C C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() C C NOTES ON VARIOUS VERSIONS OF CALPUV C @@ -630,7 +630,7 @@ CJH ENDIF C C5555 CONTINUE C - TPUV=TPUV+SECNDS(T1TMP) + TPUV=TPUV+T1TMP-SECOND() C C**********************************************************************C C @@ -715,7 +715,7 @@ C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W C C----------------------------------------------------------------------C C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(KC.GT.1)THEN CALL CALUVW (ISTL,IS2TL) ELSE @@ -732,7 +732,7 @@ C ENDDO CALL CALUVW (ISTL,IS2TL) ENDIF - TUVW=TUVW+SECNDS(T1TMP) + TUVW=TUVW+T1TMP-SECOND() C C**********************************************************************C C @@ -1260,7 +1260,7 @@ C**********************************************************************C C C ** CALCULATE TURBULENT INTENSITY SQUARED C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALQQ1OLD (ISTL) @@ -1268,7 +1268,7 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALQQ2 (ISTL) ENDIF - TQQQ=TQQQ+SECNDS(T1TMP) + TQQQ=TQQQ+T1TMP-SECOND() C C**********************************************************************C C @@ -1400,22 +1400,22 @@ C !{GEOSR, OIL, CWCHO, 101122 IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN - T1TMP=SECNDS(0.0) + T1TMP=SECOND() CALL DRIFTERC - TLRPD=TLRPD+SECNDS(T1TMP) + TLRPD=TLRPD+T1TMP-SECOND() ENDIF ENDIF !} ! IF(ISLRPD.GE.1)THEN -! T1TMP=SECNDS(0.0) +! T1TMP=SECOND() ! IF(ISLRPD.LE.2)THEN ! IF(N.GE.NLRPDRT(1)) CALL LAGRES ! ENDIF ! IF(ISLRPD.GE.3)THEN ! IF(N.GE.NLRPDRT(1)) CALL GLMRES ! ENDIF -! TLRPD=TLRPD+SECNDS(T1TMP) +! TLRPD=TLRPD+T1TMP-SECOND() ! ENDIF C C**********************************************************************C @@ -1678,7 +1678,7 @@ C**********************************************************************C C C ** TIME LOOP COMPLETED C -C1001 THDMT=THDMT+SECNDS(TTMP) +C1001 THDMT=THDMT+TTMP-SECOND() C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index 1f70804ba..7784a3627 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -72,7 +72,7 @@ C LCORNSN=0 ENDIF C - TTMP=SECNDS(0.0) + TTMP=SECOND() ICALLTP=0 C ISTL=2 @@ -602,7 +602,7 @@ C**********************************************************************C C C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALAVBOLD (ISTL) @@ -610,7 +610,7 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) ENDIF - TAVB=TAVB+SECNDS(T1TMP) + TAVB=TAVB+T1TMP-SECOND() C C**********************************************************************C C @@ -644,7 +644,7 @@ c IF(IS2TIM.EQ.1) CALL CALEXP2T ENDIF ENDIF IF(IS2TIM.EQ.2) CALL CALIMP2T - TCEXP=TCEXP+SECNDS(T1TMP) + TCEXP=TCEXP+T1TMP-SECOND() C C**********************************************************************C C @@ -661,10 +661,10 @@ C**********************************************************************C C C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(ISCHAN.EQ.0.AND.ISDRY.EQ.0) CALL CALPUV2T IF(ISCHAN.GE.1.OR.ISDRY.GE.1) CALL CALPUV2C - TPUV=TPUV+SECNDS(T1TMP) + TPUV=TPUV+T1TMP-SECOND() C C**********************************************************************C C @@ -714,7 +714,7 @@ C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W C C----------------------------------------------------------------------C C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() IF(KC.GT.1)THEN CALL CALUVW (ISTL,IS2TL) ELSE @@ -727,7 +727,7 @@ C ENDDO CALL CALUVW (ISTL,IS2TL) ENDIF - TUVW=TUVW+SECNDS(T1TMP) + TUVW=TUVW+T1TMP-SECOND() C C**********************************************************************C C @@ -1212,7 +1212,7 @@ C**********************************************************************C C C ** CALCULATE BOTTOM STRESS AT LEVEL (N+1) C - T1TMP=SECNDS(0.0) + T1TMP=SECOND() C CALL CALTBXY(ISTL,IS2TL) C @@ -1633,9 +1633,9 @@ C !{GEOSR, OIL, CWCHO, 101122 IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN !DHC IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN - T1TMP=SECNDS(0.0) + T1TMP=SECOND() CALL DRIFTERC - TLRPD=TLRPD+SECNDS(T1TMP) + TLRPD=TLRPD+T1TMP-SECOND() ENDIF ENDIF @@ -1649,14 +1649,14 @@ C !GEOSR} ! IF(ISLRPD.GE.1)THEN -! T1TMP=SECNDS(0.0) !DHC:13-04-09 +! T1TMP=SECOND() !DHC:13-04-09 ! IF(ISLRPD.LE.2)THEN ! IF(N.GE.NLRPDRT(1)) CALL LAGRES ! ENDIF ! IF(ISLRPD.GE.3)THEN ! IF(N.GE.NLRPDRT(1)) CALL GLMRES ! ENDIF -! TLRPD=TLRPD+SECNDS(T1TMP) +! TLRPD=TLRPD+T1TMP-SECOND() ! ENDIF C C**********************************************************************C @@ -1945,7 +1945,7 @@ C**********************************************************************C C C ** TIME LOOP COMPLETED C - THDMT=THDMT+SECNDS(TTMP) + THDMT=THDMT+TTMP-SECOND() C C**********************************************************************C C *** EE BEGIN BLOCK diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for index 7a6e20606..6280378cb 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for @@ -437,14 +437,13 @@ C ![ GeoSR : 2012/12/15 WRITE(1234,*) TIMEDAY,DAYNEXT,WQI1,WQI2,WQI3 ! GeoSR : 2012/12/15] - - TTMP=SECNDS(0.0) + TTMP=SECOND() IF(ISWQLVL.EQ.0) CALL WQSKE0 IF(ISWQLVL.EQ.1) CALL WQSKE1 IF(ISWQLVL.EQ.2) CALL WQSKE2 IF(ISWQLVL.EQ.3) CALL WQSKE3 IF(ISWQLVL.EQ.4) CALL WQSKE4 - TWQKIN=TWQKIN+SECNDS(TTMP) + TWQKIN=TWQKIN+TTMP-SECOND() C C ** DIAGNOSE NEGATIVE CONCENTRATIONS C @@ -463,9 +462,9 @@ C C ** CALL SEDIMENT DIAGENSIS MODEL C IF(IWQBEN.EQ.1)THEN - TTMP=SECNDS(0.0) + TTMP=SECOND() CALL SMMBE - TWQSED=TWQSED+SECNDS(TTMP) + TWQSED=TWQSED+TTMP-SECOND() IF(ISMTS.GE.1)THEN C C ** WRITE SEDIMENT MODEL TIME SERIES From 9606649cac9e3818c210c11842b2d83bde00db68 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 16:41:12 +0100 Subject: [PATCH 10/77] Change SECOND() to CPU_TIME subroutine --- .../original_efdc_files/CALCONC.for | 5 ++- .../original_efdc_files/CALWQC.for | 12 ++++--- .../original_efdc_files/CONGRAD.for | 7 ++-- .../original_efdc_files/CONGRADC.for | 7 ++-- .../original_efdc_files/HDMT.for | 34 +++++++++++-------- .../original_efdc_files/HDMT2T.for | 33 ++++++++++-------- .../original_efdc_files/WQ3D.for | 12 ++++--- .../original_efdc_files/s_main.f90 | 1 - 8 files changed, 63 insertions(+), 48 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 644fbb125..2e5d6be84 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -14,7 +14,6 @@ C INTEGER::K,L,NT,NS,ND,NSID,LDATA,NLC,IWASM,NDAYA,NX INTEGER::IBALSTDT,NTMP,ISTL_,IS2TL_,M,LF,LL REAL::TTMP,RCDZKMK,CONASMOLD,SALASM, T1TMP,T2TMP - REAL::SECNDS REAL::TEMASM,DYEASM,SFLASM,RCDZKK,CCUBTMP,CCMBTMP REAL::DELTD2,CDYETMP,TMP,DAGE INTEGER::LF_LC,LL_LC,ithds @@ -175,7 +174,7 @@ C ENDDO ENDDO ENDIF - TTMP=SECOND() + CALL CPU_TIME(TTMP) C IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).LT.4) & CALL CALTRAN (ISTL_,IS2TL_,1,1,SAL,SAL1) @@ -378,7 +377,7 @@ C ENDDO ENDIF CALL CPU_TIME(T2TMP) - TSADV=TSADV+T2TMP-T1TMP + TSADV=TSADV+T2TMP-T1TMP ENDIF C C ** 1D ADVECTI0N TRANSPORT CALCULATION diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for index e621fe5b7..8c2036cd6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC.for @@ -7,7 +7,7 @@ C ** CALLED ONLY ON ODD THREE TIME LEVEL STEPS C USE GLOBAL - REAL TTMP, SECNDS + REAL TTMP,T1TMP DELT=DT2 IF(IS2TIM.GE.1) THEN @@ -23,7 +23,7 @@ C C ** UPDATED TIME SERIES CONCENTRATION BOUNDARY CONDITIONS C ** 3D ADVECTI0N TRANSPORT CALCULATION C - TTMP=SECOND() + CALL CPU_TIME(TTMP) DO NW=1,NWQV IF(ISTRWQ(NW).EQ.1)THEN CALL CALTRAN(ISTL_,IS2TL_,8,NW,WQV(1,1,NW),WQV(1,1,NW)) @@ -33,7 +33,8 @@ C DO nsp=1,NXSP CALL CALTRAN(ISTL_,IS2TL_,8,nsp+NWQV,WQVX(1,1,nsp),WQVX(1,1,nsp)) ENDDO - TWQADV=TWQADV+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TWQADV=TWQADV+T1TMP-TTMP C C ** CALLS TO SOURCE-SINK CALCULATIONS C ** BYPASS OR INITIALIZE VERTICAL DIFFUSION CALCULATION @@ -42,7 +43,7 @@ C DO L=2,LA HWQI(L)=1./HWQ(L) ENDDO - TTMP=SECOND() + CALL CPU_TIME(TTMP) C C ** VERTICAL DIFFUSION CALCULATION LEVEL 1 C @@ -498,7 +499,8 @@ C endif ENDDO ENDIF - TWQDIF=TWQDIF+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TWQDIF=TWQDIF+T1TMP-TTMP 2000 CONTINUE RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for index 3ad5891df..f91361f96 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD.for @@ -6,7 +6,7 @@ C ** GRADIENT SCHEME C USE GLOBAL - REAL TTMP, SECNDS + REAL TTMP,T1TMP ! *** DSLLC REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PNORTH @@ -22,7 +22,7 @@ C ENDIF ! *** DSLLC C - TTMP=SECOND() + CALL CPU_TIME(TTMP) DO L=2,LA PNORTH(L)=P(LNC(L)) PSOUTH(L)=P(LSC(L)) @@ -120,7 +120,8 @@ C ENDDO ENDIF ! *** DSLLC END BLOCK - TCONG=TCONG+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TCONG=TCONG+T1TMP-TTMP C 800 FORMAT(I5,8E13.4) 808 FORMAT(2I5,9E13.4) RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for index efae541c5..b205f85a3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRADC.for @@ -6,7 +6,7 @@ C ** GRADIENT SCHEME C USE GLOBAL - REAL TTMP, SECNDS + REAL TTMP, T1TMP ! *** DSLLC REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PNORTH @@ -22,7 +22,7 @@ C ENDIF ! *** DSLLC C - TTMP=SECOND() + CALL CPU_TIME(TTMP) DO L=2,LA PNORTH(L)=P(LNC(L)) PSOUTH(L)=P(LSC(L)) @@ -173,7 +173,8 @@ C ENDDO ENDIF ! *** DSLLC END BLOCK - TCONG=TCONG+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TCONG=TCONG+T1TMP-TTMP 800 FORMAT(2I6,6E13.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index 3574754c0..14e4caf8f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -28,7 +28,7 @@ C INTEGER::IMIN,JMIN,KMIN,NMD,ITMP,ICALLTP,LS INTEGER::IPLTTMP,NRESTO,ISSREST,IRRMIN,ILOGC INTEGER::LN,LNW,LSE,LF,LL,LSW - REAL::T1TMP,SALMIN,HPPTMP,WTM,WTMP + REAL::T1TMP,T2TMP,SALMIN,HPPTMP,WTM,WTMP REAL::DELVOL,SALMAX,TAUB2,DELTD2,DZDDELT,TTMP REAL::TAUBC,TAUBC2,UTMP,VTMP,CURANG REAL::CTIM @@ -466,7 +466,7 @@ C**********************************************************************C C C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALAVBOLD (ISTL) @@ -474,7 +474,8 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) ENDIF - TAVB=TAVB+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TAVB=TAVB+T2TMP-T1TMP C C**********************************************************************C C @@ -491,7 +492,7 @@ C**********************************************************************C C C ** CALCULATE EXPLICIT MOMENTUM EQUATION TERMS C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) C C NOTES ON VARIOUS VERSIONS OF CALEXP C @@ -537,7 +538,8 @@ C PMC IF(ISCDMA.EQ.5) CALL CALEXP2 (ISTL) C PMC IF(ISCDMA.EQ.6) CALL CALEXP2 (ISTL) C PMC IF(ISCDMA.EQ.9) CALL CALEXP9 (ISTL) C - TCEXP=TCEXP+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TCEXP=TCEXP+T2TMP-T1TMP C C**********************************************************************C C @@ -554,7 +556,7 @@ C**********************************************************************C C C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) C C NOTES ON VARIOUS VERSIONS OF CALPUV C @@ -630,7 +632,8 @@ CJH ENDIF C C5555 CONTINUE C - TPUV=TPUV+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TPUV=TPUV+T2TMP-T1TMP C C**********************************************************************C C @@ -715,7 +718,7 @@ C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W C C----------------------------------------------------------------------C C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN CALL CALUVW (ISTL,IS2TL) ELSE @@ -732,7 +735,8 @@ C ENDDO CALL CALUVW (ISTL,IS2TL) ENDIF - TUVW=TUVW+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TUVW=TUVW+T2TMP-T1TMP C C**********************************************************************C C @@ -1260,7 +1264,7 @@ C**********************************************************************C C C ** CALCULATE TURBULENT INTENSITY SQUARED C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALQQ1OLD (ISTL) @@ -1268,7 +1272,8 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALQQ2 (ISTL) ENDIF - TQQQ=TQQQ+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TQQQ=TQQQ+T2TMP-T1TMP C C**********************************************************************C C @@ -1400,15 +1405,16 @@ C !{GEOSR, OIL, CWCHO, 101122 IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) CALL DRIFTERC - TLRPD=TLRPD+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TLRPD=TLRPD+T2TMP-T1TMP ENDIF ENDIF !} ! IF(ISLRPD.GE.1)THEN -! T1TMP=SECOND() +! CALL CPU_TIME(T1TMP) ! IF(ISLRPD.LE.2)THEN ! IF(N.GE.NLRPDRT(1)) CALL LAGRES ! ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index 7784a3627..fb8e02426 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -28,7 +28,7 @@ C INTRINSIC ISNAN LOGICAL ISNAN - REAL TTMP, T1TMP, TMP, SECNDS + REAL TTMP, T1TMP, TMP, T2TMP INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::ISSBCP LOGICAL BTEST, LTEST @@ -72,7 +72,7 @@ C LCORNSN=0 ENDIF C - TTMP=SECOND() + CALL CPU_TIME(TTMP) ICALLTP=0 C ISTL=2 @@ -602,7 +602,7 @@ C**********************************************************************C C C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALAVBOLD (ISTL) @@ -610,7 +610,8 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) ENDIF - TAVB=TAVB+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TAVB=TAVB+T2TMP-T1TMP C C**********************************************************************C C @@ -661,10 +662,11 @@ C**********************************************************************C C C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(ISCHAN.EQ.0.AND.ISDRY.EQ.0) CALL CALPUV2T IF(ISCHAN.GE.1.OR.ISDRY.GE.1) CALL CALPUV2C - TPUV=TPUV+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TPUV=TPUV+T2TMP-T1TMP C C**********************************************************************C C @@ -714,7 +716,7 @@ C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W C C----------------------------------------------------------------------C C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN CALL CALUVW (ISTL,IS2TL) ELSE @@ -727,7 +729,8 @@ C ENDDO CALL CALUVW (ISTL,IS2TL) ENDIF - TUVW=TUVW+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TUVW=TUVW+T2TMP-T1TMP C C**********************************************************************C C @@ -1212,7 +1215,7 @@ C**********************************************************************C C C ** CALCULATE BOTTOM STRESS AT LEVEL (N+1) C - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) C CALL CALTBXY(ISTL,IS2TL) C @@ -1485,7 +1488,7 @@ C**********************************************************************C C C ** CALCULATE TURBULENT INTENSITY SQUARED C - T1TMP=SECNDS(0.0) + CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALQQ2TOLD (ISTL) @@ -1633,9 +1636,10 @@ C !{GEOSR, OIL, CWCHO, 101122 IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN !DHC IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN - T1TMP=SECOND() + CALL CPU_TIME(T1TMP) CALL DRIFTERC - TLRPD=TLRPD+T1TMP-SECOND() + CALL CPU_TIME(T2TMP) + TLRPD=TLRPD+T2TMP-T1TMP ENDIF ENDIF @@ -1649,7 +1653,7 @@ C !GEOSR} ! IF(ISLRPD.GE.1)THEN -! T1TMP=SECOND() !DHC:13-04-09 +! CALL CPU_TIME(T1TMP) !DHC:13-04-09 ! IF(ISLRPD.LE.2)THEN ! IF(N.GE.NLRPDRT(1)) CALL LAGRES ! ENDIF @@ -1945,7 +1949,8 @@ C**********************************************************************C C C ** TIME LOOP COMPLETED C - THDMT=THDMT+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + THDMT=THDMT+T1TMP-TTMP C C**********************************************************************C C *** EE BEGIN BLOCK diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for index 6280378cb..694117310 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for @@ -8,7 +8,7 @@ C C Merged SNL and DS-INTL USE GLOBAL - REAL TTMP, SECNDS + REAL TTMP,T1TMP REAL, SAVE :: DAYNEXT REAL, SAVE :: SUNDAY1, SUNDAY2, SUNSOL1, SUNSOL2 REAL, SAVE :: SUNFRC1, SUNFRC2 @@ -437,13 +437,14 @@ C ![ GeoSR : 2012/12/15 WRITE(1234,*) TIMEDAY,DAYNEXT,WQI1,WQI2,WQI3 ! GeoSR : 2012/12/15] - TTMP=SECOND() + CALL CPU_TIME(TTMP) IF(ISWQLVL.EQ.0) CALL WQSKE0 IF(ISWQLVL.EQ.1) CALL WQSKE1 IF(ISWQLVL.EQ.2) CALL WQSKE2 IF(ISWQLVL.EQ.3) CALL WQSKE3 IF(ISWQLVL.EQ.4) CALL WQSKE4 - TWQKIN=TWQKIN+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TWQKIN=TWQKIN+T1TMP-TTMP C C ** DIAGNOSE NEGATIVE CONCENTRATIONS C @@ -462,9 +463,10 @@ C C ** CALL SEDIMENT DIAGENSIS MODEL C IF(IWQBEN.EQ.1)THEN - TTMP=SECOND() + CALL CPU_TIME(TTMP) CALL SMMBE - TWQSED=TWQSED+TTMP-SECOND() + CALL CPU_TIME(T1TMP) + TWQSED=TWQSED+T1TMP-TTMP IF(ISMTS.GE.1)THEN C C ** WRITE SEDIMENT MODEL TIME SERIES diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 index fdc1dd36a..910c8f3c0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 @@ -16,7 +16,6 @@ SUBROUTINE SEDZLJ_MAIN !**********************************************************************! ! - DO NS=1,NSED DO K=1,KC DO L=2,LA From 9df3514daadba777eb727cf0dbf3db29e3b9a802 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 16:43:41 +0100 Subject: [PATCH 11/77] Resolve warning infinite loop on READ branch This makes the implicit while loop for the READ statements explicit by moving the READ statement into a `DO WHILE` statement that runs until a satisfactory read is performed. This does not change the functionality, it merely makes the loop explicit and thereby suppresses the compiler warnings. --- .../original_efdc_files/SCANASER.for | 6 +++++- .../original_efdc_files/SCANDSER.for | 6 +++++- .../original_efdc_files/SCANGWSR.for | 6 +++++- .../original_efdc_files/SCANMODC.for | 6 +++++- .../original_efdc_files/SCANPSER.for | 6 +++++- .../original_efdc_files/SCANQSER.for | 14 ++++++++++---- .../original_efdc_files/SCANSFSR.for | 6 +++++- .../original_efdc_files/SCANSSER.for | 6 +++++- .../original_efdc_files/SCANTSER.for | 6 +++++- .../original_efdc_files/SCANWQ.for | 11 +++++++++-- .../original_efdc_files/SCANWSER.for | 6 +++++- 11 files changed, 64 insertions(+), 15 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for index 5daa22131..d5be045a2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for @@ -1,11 +1,15 @@ SUBROUTINE SCANASER USE GLOBAL CHARACTER*120 LIN + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: ASER.INP' OPEN(1,FILE='ASER.INP',STATUS='OLD') DO N=1,NASER - 10 READ(1,*,ERR=10,END=40)M,R,R,I,R,R,R,R + IOS=1 + DO WHILE (IOS > 0) + READ(1,*,IOSTAT=IOS,END=40)M,R,R,I,R,R,R,R + ENDDO READ(1,*,ERR=20,END=40)I,R,R,R,R,R,R,R,R,R NDASER=MAX(NDASER,M) DO I=1,M diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for index 27ac31e34..3759e587c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for @@ -1,9 +1,13 @@ SUBROUTINE SCANDSER(NCSER3) USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: DSER.INP' OPEN(1,FILE='DSER.INP',STATUS='OLD') DO NS=1,NCSER3 - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R + ENDDO NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for index 12ffef527..b018aef89 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for @@ -2,9 +2,13 @@ ! SUBROUTINE SCANGWSR USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: GWSER.INP' OPEN(1,FILE='GWSER.INP',STATUS='OLD') - 10 READ(1,*,ERR=10,END=40)NGWSER + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)NGWSER + ENDDO NGWSERM=MAX(1,NGWSER) DO NS=1,NGWSER READ(1,*,ERR=20,END=40)M,R,R,R,R diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for index a8ce8cced..8e9f33ee7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for @@ -1,8 +1,12 @@ SUBROUTINE SCANMODC USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: MODCHAN.INP' OPEN(1,FILE='MODCHAN.INP',STATUS='OLD') - 10 READ(1,*,ERR=10,END=40)M,I,I + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)M,I,I + ENDDO NCHANM=MAX(1,M) READ(1,*,ERR=20,END=40)I,I,R CLOSE(1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for index 05e96fd67..9bf524856 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for @@ -1,9 +1,13 @@ SUBROUTINE SCANPSER USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: PSER.INP' OPEN(1,FILE='PSER.INP',STATUS='OLD') DO NS=1,NPSER - 10 READ(1,*,ERR=10,END=40)M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)M,R,R,R,R + ENDDO NDPSER=MAX(NDPSER,M) DO I=1,M READ(1,*,ERR=20,END=40)R,R diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for index 9584fc282..ea8d71af8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for @@ -1,12 +1,15 @@ SUBROUTINE SCANQSER USE GLOBAL - INTEGER*4 NS, I, J, M - + INTEGER IOS + WRITE(*,'(A)')'SCANNING INPUT FILE: QSER.INP' OPEN(1,FILE='QSER.INP',STATUS='OLD') DO NS=1,NQSER - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R,J + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R,J + ENDDO NDQSER=MAX(NDQSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) @@ -56,7 +59,10 @@ C ***************************************************************************** OPEN(1,FILE='QWRS.INP',STATUS='OLD') DO NS=1,NQWRSR - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R + ENDDO NDQWRSR=MAX(NDQWRSR,M) IF(I.EQ.0)THEN ! *** Flow Only diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for index 19c72b481..0fc0e127f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for @@ -1,9 +1,13 @@ SUBROUTINE SCANSFSR(NCSER4) USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: SFSER.INP' OPEN(1,FILE='SFSER.INP',STATUS='OLD') DO NS=1,NCSER4 - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R + ENDDO NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for index 04be283b1..2dbe453f9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for @@ -1,9 +1,13 @@ SUBROUTINE SCANSSER(NCSER1) USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: SSER.INP' OPEN(1,FILE='SSER.INP',STATUS='OLD') DO NS=1,NCSER1 - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R + ENDDO NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for index 68348d259..9908ef7a2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for @@ -1,9 +1,13 @@ SUBROUTINE SCANTSER(NCSER2) USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: TSER.INP' OPEN(1,FILE='TSER.INP',STATUS='OLD') DO NS=1,NCSER2 - 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R + ENDDO NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for index 6291e507c..5501b6723 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for @@ -11,6 +11,7 @@ LOGICAL*4 BFLAG INTEGER*4 I,J,K,ITMP,NW REAL*4 XPSQ + INTEGER IOS LOGICAL fileExists WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP' @@ -85,7 +86,10 @@ C READ(1,1) ENDDO DO NS=1,NPSTMSR - 10 READ(1,*,ERR=10,END=20)M,TM,TA,RMULADJ,ADDADJ + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=20)M,TM,TA,RMULADJ,ADDADJ + ENDDO NDWQPSR=MAX(NDWQPSR,M) DO J=1,M !READ(1,*)T,(RLDTMP(K),K=1,NWQV) @@ -116,7 +120,10 @@ C READ(1,1) ENDDO DO NS=1,1000 - 30 READ(1,*,ERR=30,END=40)ISTYP,M,T1,T2,RMULADJ,ADDADJ + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)ISTYP,M,T1,T2,RMULADJ,ADDADJ + ENDDO IF(ISTYP.EQ.1) READ(1,*) ! GeoSR, 2014.10.13 JHLEE, CWQSR SCANNING diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for index ca431e270..b236d3adc 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for @@ -1,9 +1,13 @@ SUBROUTINE SCANWSER USE GLOBAL + INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: WSER.INP' OPEN(1,FILE='WSER.INP',STATUS='OLD') DO NS=1,NWSER - 10 READ(1,*,ERR=10,END=40)M,R,R,R,I + IOS=1 + DO WHILE (IOS>0) + READ(1,*,IOSTAT=IOS,END=40)M,R,R,R,I + ENDDO NDWSER=MAX(NDWSER,M) DO I=1,M READ(1,*,ERR=20,END=40)R,R,R From 13427317a65f6be5e1dfdd33f9b3f6b49c066163 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 16:46:24 +0100 Subject: [PATCH 12/77] Resolve compiler warnings due to `Wconversion` All implicit conversion is made explicit by inserting the required type casts to match the assigned variables. --- .../original_efdc_files/CALAVB2.for | 27 ++++++------- .../original_efdc_files/CALHEAT.for | 2 +- .../original_efdc_files/CALSTEP.for | 2 +- .../original_efdc_files/CALSTEPD.for | 2 +- .../original_efdc_files/DRIFTER.f90 | 6 +-- .../original_efdc_files/INPUT.for | 2 +- .../original_efdc_files/READWIMS1.for | 4 +- .../original_efdc_files/Sub_spore.for | 2 +- .../original_efdc_files/WINDWAVE.f90 | 26 ++++++------- .../original_efdc_files/WWQTSBIN.for | 2 +- .../original_efdc_files/s_main.f90 | 39 +++++++++++-------- .../original_efdc_files/s_morph.f90 | 6 +-- .../original_efdc_files/s_sedic.f90 | 2 +- .../original_efdc_files/s_sedzlj.f90 | 16 ++++---- .../original_efdc_files/s_shear.f90 | 4 +- 15 files changed, 74 insertions(+), 68 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for index 5d007a881..43dad61a9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB2.for @@ -59,12 +59,13 @@ C IF(RITMP.GT.0.)THEN RIQ=DML(L,K)*DML(L,K)*RITMP BFUN=EXP(-3.11*RIQ) - CTURBB1(L,K)=CTURB/(BFUN+1.E-12) + CTURBB1(L,K)=REAL(CTURB/(BFUN+1.E-12),KIND(CTURBB1)) ! *** Original Code IF(BBT(L,K).GT.0.)THEN ! *** PMC BBT is never set, so this is never used TMPVAL=DELBTMP*DELBTMP/(RITMP*BBT(L,K)) - CTURBB2(L,K)=CTURB2B/(1.+0.61*(1.-BFUN)*TMPVAL) + CTURBB2(L,K)=REAL(CTURB2B/(1.+0.61*(1.-BFUN)*TMPVAL), + & KIND(CTURBB2)) ENDIF ENDIF ENDDO @@ -89,14 +90,14 @@ C AVTMP=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO C IF(ISFAVB.EQ.0)THEN - AV(L,K)=AVTMP*HPI(L) - AB(L,K)=SCB(L)*ABTMP*HPI(L) + AV(L,K)=REAL(AVTMP*HPI(L),KIND(AV)) + AB(L,K)=REAL(SCB(L)*ABTMP*HPI(L),KIND(AB)) ELSEIF(ISFAVB.EQ.1)THEN - AV(L,K)=0.5*(AV(L,K)+AVTMP*HPI(L)) - AB(L,K)=SCB(L)*0.5*(AB(L,K)+ABTMP*HPI(L)) + AV(L,K)=REAL(0.5*(AV(L,K)+AVTMP*HPI(L)),KIND(AV)) + AB(L,K)=REAL(SCB(L)*0.5*(AB(L,K)+ABTMP*HPI(L)),KIND(AB)) ELSEIF(ISFAVB.EQ.2)THEN - AV(L,K)=SQRT(AV(L,K)*AVTMP*HPI(L)) - AB(L,K)=SCB(L)*SQRT(AB(L,K)*ABTMP*HPI(L)) + AV(L,K)=REAL(SQRT(AV(L,K)*AVTMP*HPI(L)),KIND(AV)) + AB(L,K)=REAL(SCB(L)*SQRT(AB(L,K)*ABTMP*HPI(L)),KIND(AB)) ENDIF ENDDO ENDDO @@ -122,8 +123,8 @@ C DO L=2,LA AVTMP=AVMX*HPI(L) ABTMP=ABMX*HPI(L) - AV(L,K)=MIN(AV(L,K),AVTMP) - AB(L,K)=MIN(AB(L,K),ABTMP) + AV(L,K)=REAL(MIN(AV(L,K),AVTMP),KIND(AV)) + AB(L,K)=REAL(MIN(AB(L,K),ABTMP),KIND(AB)) ENDDO ENDDO ENDIF @@ -150,14 +151,14 @@ C DO K=2,KS DO L=2,LA AQTMP=0.205*(AV(L,K-1)+AV(L,K)) - AQ(L,K)=AQTMP + AQ(L,K)=REAL(AQTMP,KIND(AQ)) ENDDO ENDDO DO L=2,LA AQTMP=0.205*AV(L,1) - AQ(L,1)=AQTMP + AQ(L,1)=REAL(AQTMP,KIND(AQ)) AQTMP=0.205*AV(L,KS) - AQ(L,KC)=AQTMP + AQ(L,KC)=REAL(AQTMP,KIND(AQ)) ENDDO ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index 241507f41..1a9a571f2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -702,7 +702,7 @@ C 600 FORMAT(4I5,2E12.4) ! *** Day of the Year THOUR = (TIMEDAY-INT(TIMEDAY))*24.0 - IDAY = TIMEDAY-INT(TIMEDAY/365.)*365. + IDAY = INT(TIMEDAY-INT(TIMEDAY/365.)*365.,KIND(IDAY)) IDAY = IDAY+INT(INT(TIMEDAY/365.)/4.) JDAY = REAL(IDAY) PMC1 = (2.*PI*(JDAY-1.))/365. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for index 148f47cd3..369b27975 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for @@ -273,7 +273,7 @@ C C ** ADJUST INCREMENT FOR N TO LAND EVENLY ON NTSPTC C RTCTMP=FLOAT(N)/FLOAT(NTSPTC) - NTCTMP=RTCTMP + NTCTMP=INT(RTCTMP,KIND(NTCTMP)) NTMP=(1+NTCTMP)*NTSPTC-N IF(NINCRMT.GT.NTMP)THEN NINCRMT=NTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for index 49025cc26..1a5244f67 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for @@ -295,7 +295,7 @@ C C ** ADJUST INCREMENT FOR N TO LAND EVENLY ON NTSPTC C RTCTMP=FLOAT(N)/FLOAT(NTSPTC) - NTCTMP=RTCTMP + NTCTMP=INT(RTCTMP,KIND(NTCTMP)) NTMP=(1+NTCTMP)*NTSPTC-N IF(NINCRMT.GT.NTMP)THEN NINCRMT=NTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 index f39144313..22ca78760 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 @@ -87,7 +87,7 @@ SUBROUTINE DRIFTERC ! ******************************************************** !FLUSH(ULGR) CALL FLUSH(ULGR) !ykchoi] - TIMENEXT=TIMEDAY+LA_FREQ+0.000001 + TIMENEXT=REAL(TIMEDAY+LA_FREQ+0.000001,KIND(TIMENEXT)) ENDIF !----NEXT CALL--------------------------- @@ -101,7 +101,7 @@ SUBROUTINE DRIFTERC ! ******************************************************** ALFA = (CFAY_2*CFAY_2/32.0)*(DELTARHO*G*OILVOLINI**2/sqrt(WKVISC))**(1./3.) IF(OSPD.EQ.1) THEN TRANSTIME = (CFAY_2/CFAY_1)**4 * (OILVOLINI/(G*DELTARHO*WKVISC))**(1./3.) - DIFFCOEF = ALFA*(1/SQRT(TRANSTIME)) + DIFFCOEF = REAL(ALFA*1/SQRT(TRANSTIME), KIND(DIFFCOEF)) ALFA_OLD = ALFA OSPD=0 ELSE @@ -311,7 +311,7 @@ SUBROUTINE DRIFTERC ! ******************************************************** !FLUSH(ULGR) CALL FLUSH(ULGR) !ykchoi] - TIMENEXT = TIMENEXT+LA_FREQ + TIMENEXT = REAL(TIMENEXT+LA_FREQ,KIND(TIMENEXT)) ENDIF END SUBROUTINE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index 00415d4e8..f5a68cf34 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -157,7 +157,7 @@ C8** READ TIME-RELATED REAL PARAMETERS !{GEOSR, TOX, YSSONG, 101125, JGCHO 110125 IF(IDTOX.GE.0) THEN TBEGIN=TBEGIN1 - NTSPTC=TIDALP/USERDT + NTSPTC=INT(TIDALP/USERDT,KIND(NTSPTC)) !NTC=NTC1*86400/INT(TIDALP) NTC=NTC1/INT(TIDALP) ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index 83e012545..c1e540215 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -182,12 +182,12 @@ C----------------------------------------------------------------------C DATE3=DATE2+153 IF(IMONTH.GE.3 .AND. IMONTH.LE.7 ) THEN - ITDATE=DATE2 + ITDATE=INT(DATE2,KIND(ITDATE)) IRMONTH=8 ENDIF IF(IMONTH.GE.8 .AND. IMONTH.LE.12 ) THEN - ITDATE=DATE3 + ITDATE=INT(DATE3,KIND(ITDATE)) IRMONTH=13 ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for index f42bb16fb..a5c6d52a8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for @@ -58,7 +58,7 @@ C Average temperature LightAVG(L)=WQ_Light(L) ENDIF - ICYAM = ICYAMAP(L) + ICYAM = INT(ICYAMAP(L),KIND(ICYAM)) GER0(L) = CUM_GER(L) IF(TEMAVG(L).GE.CYA_TEM.AND.WQV(L,1,10).GE.CYA_P4D.AND. & WQV(L,1,15).GE.CYA_NO3.AND.LightAVG(L).GE.CYA_Light) THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 index 30c349b41..50a5ad206 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 @@ -35,7 +35,7 @@ SUBROUTINE WINDWAVETUR !** GENERATE WAVE TABLE: IT IS NOT USED BY WIND WAVE DO L=2,LA WVKHP(L)=1. - IF(WVWHA(L).GE.WHMI) WVKHP(L)=2*PI/WV%RLS(L)*HP(L) + IF(WVWHA(L).GE.WHMI) WVKHP(L)=REAL(2*PI/WV%RLS(L)*HP(L),KIND(WVKHP)) ENDDO ! *** ADJUST WAVE HEIGHTS DEPENDING ON VEGETATION @@ -62,8 +62,8 @@ SUBROUTINE WINDWAVETUR DO L=2,LA IF(WVWHA(L).GE.WHMI)THEN - UWORBIT=WV%UDEL(L) - AEXTMP=MAX(KSW,UWORBIT/WVFRQL(L)) !TO CONTROL FW + UWORBIT=REAL(WV%UDEL(L),KIND(UWORBIT)) + AEXTMP=REAL(MAX(KSW,UWORBIT/WVFRQL(L)),KIND(AEXTMP)) !TO CONTROL FW UWVSQ(L)=UWORBIT*UWORBIT IF (UWVSQ(L)<1.E-6) UWVSQ(L)=0. ! PMC @@ -76,9 +76,9 @@ SUBROUTINE WINDWAVETUR QQWV1(L)=CDTMP*UWORBIT*UWORBIT ELSE !** TURBULENT ROUGH WAVE BOUNDARY LAYER - RA= AEXTMP/KSW + RA=REAL(AEXTMP/KSW,KIND(RA)) WV%FW = EXP(5.5*RA**(-0.2)-6.3) ! *** Nielsen (1992) for all RA's - CDTMP=0.5*WV%FW + CDTMP=REAL(0.5*WV%FW,KIND(CDTMP)) QQWV1(L)=CDTMP*UWORBIT*UWORBIT ENDIF ELSE @@ -88,8 +88,8 @@ SUBROUTINE WINDWAVETUR WVFRQL(L)=0. ENDIF - WV%TWX(L)=RHO*QQWV1(L)*WV%TWX(L) - WV%TWY(L)=RHO*QQWV1(L)*WV%TWY(L) + WV%TWX(L)=REAL(RHO*QQWV1(L)*WV%TWX(L),KIND(WV%TWX)) + WV%TWY(L)=REAL(RHO*QQWV1(L)*WV%TWY(L),KIND(WV%TWY)) ENDDO IF (TIMEDAY>=SNAPSHOTS(NSNAPSHOTS)) THEN @@ -132,8 +132,8 @@ SUBROUTINE WINDWAVECAL WVEL = SQRT(WVEL2) IF (HP(L)>HDRY.AND.WVEL>1D-6) THEN - WV%TWX(L)=WINX/WVEL - WV%TWY(L)=WINY/WVEL + WV%TWX(L)=REAL(WINX/WVEL,KIND(WV%TWX)) + WV%TWY(L)=REAL(WINY/WVEL,KIND(WV%TWY)) !AVEDEP=HP(L) IF(WINX>=0) THEN WDIR = ACOS(WV%TWY(L))*180./PI !DEG. (NORTH,WIND TO) @@ -146,14 +146,14 @@ SUBROUTINE WINDWAVECAL FC3 =TANH(0.530*(9.81*AVEDEP/WVEL2)**0.75) FC1=WVEL2/9.81*0.283*FC3 FC2=TANH(0.0125*(9.81*FWDIR(L,ZONE)/WVEL2)**0.42/FC3) - WVWHA(L)=MIN(0.75*HP(L),FC1*FC2) !INCLUDING BREAKING WAVE + WVWHA(L)=MIN(0.75*HP(L),REAL(FC1*FC2,KIND(WVWHA(L)))) !INCLUDING BREAKING WAVE ! *** WAVE FREQUENCY FC3 = TANH(0.833*(9.81*AVEDEP/WVEL2)**0.375) FC1=(WVEL/9.81)*7.54*FC3 FC2=TANH(0.077*(9.81*FWDIR(L,ZONE)/WVEL2)**0.25/FC3) - TP=MAX(1.0E-6,FC1*FC2) ! PERIOD - WVFRQL(L)=2.0*PI/TP ! FREQUENCY OMEGA + TP=MAX(1D-6,FC1*FC2) ! PERIOD + WVFRQL(L)=REAL(2.0*PI/TP,KIND(WVFRQL)) ! FREQUENCY OMEGA ! *** ORBITAL VELOCITY FC1=(2.0*PI/TP)**2*HP(L)/9.8 @@ -166,7 +166,7 @@ SUBROUTINE WINDWAVECAL ENDIF ! *** WAVE DIRECTION (RADIANS) ANTICLOCKWISE (CELL-EAST AXIS,WAVE) - WACCWE(L)=(90-WDIR-ROTAT)*PI/180._8 + WACCWE(L)=REAL((90-WDIR-ROTAT)*PI/180._8,KIND(WACCWE)) ELSE WVWHA(L) = 0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for index 896cc114e..d4208fd61 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for @@ -342,7 +342,7 @@ C XMRM = SQRT(U(LL,K)*U(LL,K) + V(LL,K)*V(LL,K)) C C NOW COMBINE REAERATION DUE TO WATER VELOCITY AND WIND STRESS: C - IWQTMRM = 10.0*TEM(LL,K) + 151 + IWQTMRM = INT(10.0*TEM(LL,K),KIND(IWQTMRM)) + 151 C DZWQMRM = 1.0 / (DZC(K)*HP(LL)) C XMRM = - (WQVREA + WQWREA) * DZWQMRM*WQTDKR(IWQTMRM) XMRM = - (WQVREA + WQWREA) * WQTDKR(IWQTMRM,IZ) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 index 910c8f3c0..4dc702cb9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_main.f90 @@ -31,7 +31,9 @@ SUBROUTINE SEDZLJ_MAIN CALL SEDZLJ_SHEAR ! !Calculating the morphology before sediment transport of each time step. - IF(IMORPH_SEDZLJ==1)FORALL(L=2:LA)HBED(L,1:KB)=0.01*(TSED(1:KB,L)/BULKDENS(1:KB,L)) + IF(IMORPH_SEDZLJ==1) THEN + FORALL(L=2:LA) HBED(L,1:KB) = REAL(0.01*(TSED(1:KB,L)/BULKDENS(1:KB,L)),KIND(HBED)) + ENDIF !TSED-sediment layer's thickness. HBED-Bed height. BULKDENS-Density of sediment and water in layer. ! !Setting the sediment concentration in the current. SEDS is a saved version of SED (the sediment @@ -50,7 +52,7 @@ SUBROUTINE SEDZLJ_MAIN ! !WSETA - temporary settling velocity. The division of DWS by 100.0 probably has to do with unit conversion. !going from cm/s to m/s. - FORALL(K=0:KS,L=2:LA)WSETA(L,K,1:NSCM)=DWS(1:NSCM)/100.0 + FORALL(K=0:KS,L=2:LA)WSETA(L,K,1:NSCM)=REAL(DWS(1:NSCM)/100.0,KIND(WSETA)) SEDF(2:LA,0:KS,1:NSCM)=0.0 !if(minval(SEDF) < 0.0) then !print *, 'Negative SEDF 0' @@ -68,7 +70,7 @@ SUBROUTINE SEDZLJ_MAIN WVEL(L)=DELT*HPI(L)*DZIC(KC) CLEFT(L)=1.0+WSETA(L,KC-1,NS)*WVEL(L) CRIGHT(L)=MAX(SED(L,KC,NS),0.0) - SED(L,KC,NS)=CRIGHT(L)/CLEFT(L) + SED(L,KC,NS)=REAL(CRIGHT(L)/CLEFT(L),KIND(SED)) SEDF(L,KC-1,NS)=-WSETA(L,KC-1,NS)*SED(L,KC,NS) ENDFORALL !PT: added if loop to allow code to run faster for KC = 2 case. @@ -78,7 +80,7 @@ SUBROUTINE SEDZLJ_MAIN WVEL(L)=DELT*HPI(L)*DZIC(K) CLEFT(L)=1.0+WSETA(L,K-1,NS)*WVEL(L) CRIGHT(L)=MAX(SED(L,K,NS),0.0)-SEDF(L,K,NS)*WVEL(L) - SED(L,K,NS)=CRIGHT(L)/CLEFT(L) + SED(L,K,NS)=REAL(CRIGHT(L)/CLEFT(L),KIND(SED)) SEDF(L,K-1,NS)=-WSETA(L,K-1,NS)*SED(L,K,NS) ENDFORALL ENDDO @@ -103,9 +105,11 @@ SUBROUTINE SEDZLJ_MAIN ! ** Update the bed thickness based on the flux and calculate ! the flux into the water column. ! - QSBDTOP(L)=SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM)) + QSBDTOP(L)=REAL(SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM)),KIND(QSBDTOP)) DO NS=1,NSCM - QWBDTOP(L)=QWBDTOP(L)+SSGI(NS)*(VDRBED(L,KBT(L))*MAX(SEDF(L,0,NS),0.0)+VDRDEPO(NS)*MIN(SEDF(L,0,NS),0.0)) + QWBDTOP(L)=REAL(QWBDTOP(L)+SSGI(NS)*(VDRBED(L,KBT(L))*MAX(SEDF(L,0,NS),0.0) & + +VDRDEPO(NS)*MIN(SEDF(L,0,NS),0.0)), & + KIND(QWBDTOP)) ENDDO ! delme @@ -128,7 +132,7 @@ SUBROUTINE SEDZLJ_MAIN CRNUM(L)=1.0+DELT*WSETA(L,K,NS)*HPI(L)*DZIC(K+1) GRADSED(L)=(SED(L,K+1,NS)-SED(L,K,NS))/(DZC(K+1)+DZC(K)) SEDAVG(L)=0.5*(SED(L,K+1,NS)+SED(L,K,NS)+1.0E-16) - WSETA(L,K,NS)=-CRNUM(L)*DZC(K+1)*WSETA(L,K,NS)*GRADSED(L)/SEDAVG(L) + WSETA(L,K,NS)=REAL(-CRNUM(L)*DZC(K+1)*WSETA(L,K,NS)*GRADSED(L)/SEDAVG(L),KIND(WSETA)) ENDFORALL ENDDO ! @@ -195,7 +199,7 @@ SUBROUTINE SEDZLJ_MAIN CRNUM=1.+DELT*WSETA(2:LA,K,NS)*HPI(2:LA)*DZIC(K+1) GRADSED=(SED(2:LA,K+1,NS)-SED(2:LA,K,NS))/(DZC(K+1)+DZC(K)) SEDAVG=0.5*(SED(2:LA,K+1,NS)-SED(2:LA,K,NS)+1.E-16) - WSETA(2:LA,K,NS)=-CRNUM*DZC(K+1)*WSETA(2:LA,K,NS)*GRADSED/SEDAVG + WSETA(2:LA,K,NS)=REAL(-CRNUM*DZC(K+1)*WSETA(2:LA,K,NS)*GRADSED/SEDAVG,KIND(WSETA)) ENDDO ! ! TVAR1S=LOWER DIAGONAL @@ -275,8 +279,8 @@ SUBROUTINE SEDZLJ_MAIN BB11=DELTI*DZC(1)*HP(L)*SED(L,1,NS) BB22=DELTI*DZC(KC)*HP(L)*SED(L,KC,NS) DETI=1./(AA11*AA22-AA12*AA21) - SED(L,1,NS)=DETI*( BB11*AA22-BB22*AA12 ) - SED(L,KC,NS)=DETI*( AA11*BB22-AA21*BB11 ) + SED(L,1,NS)=REAL(DETI*( BB11*AA22-BB22*AA12 ), KIND(SED)) + SED(L,KC,NS)=REAL(DETI*( AA11*BB22-AA21*BB11 ), KIND(SED)) ENDDO ENDIF ! @@ -301,7 +305,7 @@ SUBROUTINE SEDZLJ_MAIN ! SEDZLJ Sediment and Contaminant Transport model ! DO NS=1,NSCM - FORALL(L=2:LA,K=0:KS)WSETA(L,K,NS)=DWS(NS)/100. + FORALL(L=2:LA,K=0:KS)WSETA(L,K,NS)=REAL(DWS(NS)/100.,KIND(WSETA)) !----------------------------------------------------------------------! ! ! ** HORIZONTAL LOOPS @@ -311,7 +315,7 @@ SUBROUTINE SEDZLJ_MAIN WVEL(2:LA)=DELT*HPI(2:LA)*DZIC(K) CLEFT(2:LA)=1.0+WSETA(2:LA,K-1,NS)*WVEL(2:LA) CRIGHT(2:LA)=MAX(SED(2:LA,K,NS),0.0) - SED(2:LA,K,NS)=CRIGHT(2:LA)/CLEFT(2:LA) + SED(2:LA,K,NS)=REAL(CRIGHT(2:LA)/CLEFT(2:LA),KIND(SED)) SEDF(2:LA,K-1,NS)=-WSETA(2:LA,K-1,NS)*SED(2:LA,K,NS) !if(minval(SEDF) < 0.0) then !print *, 'Negative SEDF 7' @@ -322,7 +326,7 @@ SUBROUTINE SEDZLJ_MAIN WVEL(2:LA)=DELT*HPI(2:LA)*DZIC(K) CLEFT(2:LA)=1.0+WSETA(2:LA,K-1,NS)*WVEL(2:LA) CRIGHT(2:LA)=MAX(SED(2:LA,K,NS),0.0)-SEDF(2:LA,K,NS)*WVEL(2:LA) - SED(2:LA,K,NS)=CRIGHT(2:LA)/CLEFT(2:LA) + SED(2:LA,K,NS)=REAL(CRIGHT(2:LA)/CLEFT(2:LA),KIND(SED)) SEDF(2:LA,K-1,NS)=-WSETA(2:LA,K-1,NS)*SED(2:LA,K,NS) !if(minval(SEDF) < 0.0) then !print *, 'Negative SEDF 8' @@ -340,9 +344,10 @@ SUBROUTINE SEDZLJ_MAIN ! ** Update the bed thickness based on the flux and calculate ! the flux into the water column. ! - QSBDTOP(L)=SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM)) - QWBDTOP(L)=VDRBED(L,KBT(L))*SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)>0.0) & - +SUM(SSGI(1:NSCM)*VDRDEPO(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)<0.0) + QSBDTOP(L)=REAL(SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM)),KIND(QSBDTOP)) + QWBDTOP(L)=REAL(VDRBED(L,KBT(L))*SUM(SSGI(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)>0.0) & + +SUM(SSGI(1:NSCM)*VDRDEPO(1:NSCM)*SEDF(L,0,1:NSCM),SEDF(L,0,1:NSCM)<0.0), & + KIND(QWBDTOP)) !DO NS=1,NSCM !QWBDTOP(L)=QWBDTOP(L)+SSGI(1:NSCM)*(VDRBED(L,KBT(L))*MAX(SEDF(L,0,NS),0.0)+VDRDEPO(NS)*MIN(SEDF(L,0,NS),0.0)) !ENDDO @@ -361,7 +366,7 @@ SUBROUTINE SEDZLJ_MAIN CRNUM(L)=1.0+DELT*WSETA(L,K,NS)*HPI(L)*DZIC(K+1) GRADSED(L)=(SED(L,K+1,NS)-SED(L,K,NS))/(DZC(K+1)+DZC(K)) SEDAVG(L)=0.5*(SED(L,K+1,NS)+SED(L,K,NS)+1.0E-16) - WSETA(L,K,NS)=-CRNUM(L)*DZC(K+1)*WSETA(L,K,NS)*GRADSED(L)/SEDAVG(L) + WSETA(L,K,NS)=REAL(-CRNUM(L)*DZC(K+1)*WSETA(L,K,NS)*GRADSED(L)/SEDAVG(L),KIND(WSETA)) ENDFORALL ENDDO ! diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 index b5d2a90ba..87bd06e41 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_morph.f90 @@ -22,10 +22,10 @@ SUBROUTINE MORPHJ HTMP(L)=HP(L) H1P(L)=HP(L) P1(L)=P(L) - HBEDA(L)=0.01*SUM(TSED(1:KB,L)/BULKDENS(1:KB,L)) - HBED(L,1:KB)=0.01*TSED(1:KB,L)/BULKDENS(1:KB,L) + HBEDA(L)=REAL(0.01*SUM(TSED(1:KB,L)/BULKDENS(1:KB,L)),KIND(HBEDA)) + HBED(L,1:KB)=REAL(0.01*TSED(1:KB,L)/BULKDENS(1:KB,L),KIND(HBEDA)) BELV(L)=ZELBEDA(L)+HBEDA(L) - HP(L)=HP(L)+DELBED(L) + HP(L)=HP(L)+REAL(DELBED(L),KIND(HP)) ENDDO !print*,0.01*SUM(TSED(1:KB,2:LA)/BULKDENS(1:KB,2:LA)),sum(belv(2:LA)),sum(hp(2:LA)),sum(delbed(2:la)) DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 index 63f5da5f0..e5a1ce685 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedic.f90 @@ -196,7 +196,7 @@ SUBROUTINE SEDIC !READ (10,'(A80)') STR_LINE !READ(10,*) (TSED0S(LL),LL=1,KB) FORALL(LL=1:2)BEDLINIT(2:LA,LL)=0.0 - FORALL(LL=3:KB)BEDLINIT(2:LA,LL)=0.01*MAX(1D-12,TSED0S(LL)) + FORALL(LL=3:KB)BEDLINIT(2:LA,LL)=REAL(0.01*MAX(1E-12,TSED0S(LL)),KIND(BEDLINIT)) FORALL(LL=1:KB)HBED(2:LA,LL)=BEDLINIT(2:LA,LL) !************************************************************************** diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 index 12b770988..a49ac1e5a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 @@ -149,13 +149,13 @@ SUBROUTINE SEDZLJ(L) SURFACE=SLLN(L) !otherwise the top layer is SLLN ENDIF D50AVG(L)=SUM(PER(1:NSCM,SURFACE,L)*D50(1:NSCM)) !calculate local d50 at sediment bed surface - FORALL(LL=1:KB)SEDDIA50(L,LL)=SUM(PER(1:NSCM,LL,L)*D50(1:NSCM)) !EFDC variable + FORALL(LL=1:KB)SEDDIA50(L,LL)=REAL(SUM(PER(1:NSCM,LL,L)*D50(1:NSCM)),KIND(SEDDIA50)) !EFDC variable ! Identify Size Class interval to use for Taucrit erosion calculation DO K=1,NSICM-1 IF(D50AVG(L)>=SCND(K).AND.D50AVG(L)=SCND(K).AND.D50AVG(L) Date: Thu, 30 Nov 2023 16:55:23 +0100 Subject: [PATCH 13/77] Initialise variables that are maybe uninitialised This resolves the corresponding warnings raised by `-Wmaybe-uninitialized`. --- .../efdc_fortran_dll/original_efdc_files/CALBLAY.for | 1 + .../efdc_fortran_dll/original_efdc_files/CALFQC.for | 6 ++++++ .../efdc_fortran_dll/original_efdc_files/CALHDMF.for | 1 + .../efdc_fortran_dll/original_efdc_files/CALHEAT.for | 8 ++++++++ .../original_efdc_files/CALPUV2C.for | 3 +++ .../original_efdc_files/CALPUV2T.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/CALPUV9.for | 5 +++++ .../original_efdc_files/CALPUV9C.for | 7 +++++++ .../efdc_fortran_dll/original_efdc_files/CALSFT.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/CALSTEP.for | 8 ++++++++ .../original_efdc_files/CALSTEPD.for | 8 ++++++++ .../efdc_fortran_dll/original_efdc_files/CALTBXY.for | 6 ++++++ .../efdc_fortran_dll/original_efdc_files/CALTRAN.for | 3 ++- .../original_efdc_files/CALTRANQ.for | 2 ++ .../original_efdc_files/CGATEFLX.for | 7 +++++++ .../efdc_fortran_dll/original_efdc_files/COSTRAN.for | 4 ++++ .../original_efdc_files/COSTRANW.for | 3 +++ .../original_efdc_files/CSEDRESS.for | 1 + .../efdc_fortran_dll/original_efdc_files/CSEDSET.for | 1 + .../efdc_fortran_dll/original_efdc_files/CSEDVIS.for | 1 + .../efdc_fortran_dll/original_efdc_files/CSNDEQC.for | 1 + .../efdc_fortran_dll/original_efdc_files/DRIFTER.f90 | 4 ++++ .../efdc_fortran_dll/original_efdc_files/DUMP.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/FSBDLD.for | 1 + .../efdc_fortran_dll/original_efdc_files/HDMT.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/HDMT2T.for | 8 ++++++++ .../efdc_fortran_dll/original_efdc_files/INPUT.for | 1 + .../efdc_fortran_dll/original_efdc_files/JPEFDC.for | 12 ++++++++++++ .../efdc_fortran_dll/original_efdc_files/LUDCMP.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/NEGDEP.for | 2 ++ .../original_efdc_files/READWIMS1.for | 1 + .../efdc_fortran_dll/original_efdc_files/RELAX2T.for | 2 ++ .../original_efdc_files/RSALPLTH.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/RWQBEN2.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/SALPLTH.for | 2 ++ .../original_efdc_files/SETSTVEL.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 | 4 ++++ .../efdc_fortran_dll/original_efdc_files/SUBCHAN.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/SVDCMP.for | 3 +++ .../original_efdc_files/Sub_spore.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/TOXCHEM.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/VALKH.for | 1 + .../efdc_fortran_dll/original_efdc_files/WASP5.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/WASP6.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/WASP7.for | 2 ++ .../original_efdc_files/WASP7EPA.for | 2 ++ .../original_efdc_files/WINDWAVE.f90 | 2 ++ .../efdc_fortran_dll/original_efdc_files/WQ3D.for | 4 ++++ .../efdc_fortran_dll/original_efdc_files/WQSKE0.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/WQSKE1.for | 11 +++++++++++ .../efdc_fortran_dll/original_efdc_files/WQSKE2.for | 10 ++++++++++ .../efdc_fortran_dll/original_efdc_files/WQSKE3.for | 9 +++++++++ .../efdc_fortran_dll/original_efdc_files/WQSKE4.for | 11 +++++++++++ .../original_efdc_files/WWQTSBIN.for | 3 +++ .../efdc_fortran_dll/original_efdc_files/ZBRENT.for | 4 ++++ .../original_efdc_files/foodchain.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/s_shear.f90 | 3 +++ 57 files changed, 212 insertions(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBLAY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBLAY.for index 03e5646a8..c30609ea6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBLAY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBLAY.for @@ -9,6 +9,7 @@ C INTEGER::K,NS,L,NT,NX REAL::TMPBOT2,TMPTOP1,TMPTOP2,TMPVAL,HBEDMXT,HOLDTOP,FKBTP REAL::SEDBOLD,TOXBOLD,TMPBOT1,FKBT,SNDBOLD + NS=0 C C FOR TRANSPORT OF COHESIVE SEDIMENT ONLY SET HBEDMIN TO FRACTION C OF HBEDMAX diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for index 29edda47c..273220b4d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for @@ -16,6 +16,12 @@ C & QSUMNAD(0:LCM1,KCM),QSUMPAD(0:LCM1,KCM) REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ + REAL QVKTMP,QUKTMP + + L = 0 + QVKTMP = 0.0 + QUKTMP = 0.0 + IF(.NOT.ALLOCATED(CONQ))THEN ALLOCATE(CONQ(LCM,KCM)) CONQ=0.0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for index 4e0f4d5d4..687a8561f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF.for @@ -38,6 +38,7 @@ C SXY2NN=0.0 HMC=0.0 ENDIF + SLIPCO=0.0 C AHMAX=AHO C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index 1a9a571f2..502ff16e6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -85,6 +85,14 @@ C !REAL,SAVE :: PTIME !REAL,SAVE :: PMCTOL REAL K_ABOVE + REAL WQCHLS_ABOVE + REAL TSSS_ABOVE + REAL POMS_ABOVE + REAL EXPBOT + WQCHLS_ABOVE = 0.0 + TSSS_ABOVE = 0.0 + POMS_ABOVE = 0.0 + EXPBOT = 0.0 C IF(.NOT.ALLOCATED(NETRAD))THEN ALLOCATE(NETRAD(LCM,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for index 16a469010..64d48bf3f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for @@ -28,6 +28,9 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DIFQVOL REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SUB1 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVB1 + INTEGER LMIN, LMAX + LMIN=0 + LMAX=0 IF(.NOT.ALLOCATED(IACTIVE))THEN ALLOCATE(IACTIVE(NCHANM)) ALLOCATE(IQDRYDWN(LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for index ca0ca6a38..92bb03c20 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2T.for @@ -15,6 +15,9 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANUT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANVT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QSUMTMP + INTEGER LMIN,LMAX + LMIN = 0 + LMAX = 0 IF(.NOT.ALLOCATED(QCHANUT))THEN ALLOCATE(QCHANUT(NCHANM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for index e3efc61c0..54138f72e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9.for @@ -8,6 +8,11 @@ C USE GLOBAL REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QSUMTMP + INTEGER LMIN,LMAX + INTEGER INEGFLG + LMIN = 0 + LMAX = 0 + INEGFLG = 0 IF(.NOT.ALLOCATED(QSUMTMP))THEN ALLOCATE(QSUMTMP(LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for index 7fcc08815..7e94dd0c6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV9C.for @@ -10,6 +10,13 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANUT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANVT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QSUMTMP + REAL HCHNCOR + INTEGER LMIN,LMAX + INTEGER INEGFLG + LMIN = 0 + LMAX = 0 + INEGFLG = 0 + HCHNCOR = 0.0 IF(.NOT.ALLOCATED(QCHANUT))THEN ALLOCATE(QCHANUT(NCHANM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT.for index f7de783cf..f80031a1d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT.for @@ -10,6 +10,8 @@ C ! *** DSLLC BEGIN BLOCK REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WTFKB REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WTFKC + INTEGER ISDARK + ISDARK=0 IF(.NOT.ALLOCATED(WTFKB))THEN ALLOCATE(WTFKB(KCM)) ALLOCATE(WTFKC(KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for index 369b27975..af0a523ad 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for @@ -11,6 +11,14 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL3 REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUBINN REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUBOUT + REAL DTCOMP + REAL QVKTMP + REAL QUKTMP + INTEGER LLOC + LLOC = 0 + DTCOMP = 0.0 + QVKTMP = 0.0 + QUKTMP = 0.0 IF(.NOT.ALLOCATED(DTL1))THEN ALLOCATE(DTL1(LCM)) ALLOCATE(DTL2(LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for index 1a5244f67..5c5bd0179 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for @@ -11,6 +11,14 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL3 REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUBINN REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUBOUT + REAL DTCOMP + REAL QVKTMP + REAL QUKTMP + INTEGER LLOC + LLOC = 0 + DTCOMP = 0.0 + QVKTMP = 0.0 + QUKTMP = 0.0 IF(.NOT.ALLOCATED(DTL1))THEN ALLOCATE(DTL1(LCM)) ALLOCATE(DTL2(LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for index 4bbeb8178..2d74be421 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for @@ -37,6 +37,12 @@ C INTEGER::LF,LL,ithds REAL::t00,rtc + LZBMIN=0 + LZBMAX=0 + LCDMIN=0 + LCDMAX=0 + WVDTMP=0.0 + DELT=DT2 ISUD=1 IF(ISTL_.NE.3)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index a675cbd24..5a83ad18b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -20,8 +20,9 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::POS - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::WQBCCON + REAL CTMP + CTMP=0.0 ALLOCATE(UTERM0(LC,KC)) ALLOCATE(VTERM0(LC,KC)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRANQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRANQ.for index fde15c129..f85b02201 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRANQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRANQ.for @@ -8,6 +8,8 @@ C ** THE NUMBER OF TIME LEVELS IN THE STEP C USE GLOBAL DIMENSION QCON(LCM,0:KCM),QCON1(LCM,0:KCM) + INTEGER L + L=0 C BSMALL=1.0E-6 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for index 2303243f0..246b3fc45 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for @@ -29,6 +29,13 @@ C REAL CG10 REAL CQ(LCM),CV(LCM) ! GEOSR UNG 2014.11.12 Warning message writing CHARACTER*256 FMTSTR + M1=0 + NGATET=0 + GQPLO=0.0 + GQPHI=0.0 + GQ1=0.0 + GLOLEV=0.0 + GHILEV=0.0 ! open time control : jgcho 2010.8.17 temporary ! IF (N.EQ.1) GATEOTM=1.0 ! GTIMENOW=TIMEDAY !N*DT/86400. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for index f04daac31..5af196f54 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for @@ -10,6 +10,8 @@ C USE GLOBAL C DIMENSION CON(LCM,KCM),CON1(LCM,KCM) + REAL CTMP + REAL RDZIC C !*** DSLLC BEGIN REAL,ALLOCATABLE,DIMENSION(:,:)::CONCX @@ -32,6 +34,8 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD + CTMP=0.0 + RDZIC=0.0 IF(.NOT.ALLOCATED(CONCX))THEN ALLOCATE(CONCX(LCM,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for index c7e0e4ae1..31cd23130 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for @@ -49,6 +49,9 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD + REAL CSTARP + REAL CSTARN + REAL CTMP IF(.NOT.ALLOCATED(CONCX))THEN ALLOCATE(CONCX(LCM,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDRESS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDRESS.for index 5e3aa9485..99a1dab42 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDRESS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDRESS.for @@ -15,6 +15,7 @@ C ** C ** SANFORD, L.P., AND J. P. Y. MAA, 2001: A UNIFIED EROSION FORMULATI C ** FOR FINE SEDIMENT, MARINE GEOLOGY, 179, 9-23. C + CSEDRESS=0.0 IF(IOPT.EQ.1)THEN BULKDEN=0.001*DENBULK ! *** PMC IF(BULKDEN.LE.1.065)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDSET.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDSET.for index 6b46efdda..2a9a2edb1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDSET.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDSET.for @@ -7,6 +7,7 @@ C ** CALCULATES CONCENTRATION DEPENDENT SETTLING VELOCITY OF COHESIVE C ** SEDIMENT C *** DSLLC BEGIN BLOCK C + CSEDSET=0.0 IF(SED.LE.0.0001)THEN CSEDSET=0.0 RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDVIS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDVIS.for index 80a131ac5..031df9c2a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDVIS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSEDVIS.for @@ -10,6 +10,7 @@ C ** MEHTA, A. J., AND F.JIANG, 1990: SOME OBSERVATIONS ON BOTTOM C ** MUD MOTION DUE TO WAVES. COASTAL AND OCEANOGRAPHIC ENGINEERING C ** DEPARTMENT, UNIVERSITY OF FLORIDA, GAINESVILLE, FL32661 C + VISR=0.0 IF(SED.LE.25667.) VISR=0.116883E-3*SED IF(SED.GE.36667.) VISR=1.52646E-6*SED+3.125 IF(SED.GT.25667.0.AND.SED.LT.36667.0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for index 254aaab33..abf22aa36 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CSNDEQC.for @@ -11,6 +11,7 @@ C ** C ** GARCIA, M., AND G. PARKER, 1991: ENTRAINMENT OF BED SEDIMENT C ** INTO SUSPENSION, J. HYDRAULIC ENGINEERING, 117, 414-435. C + CSNDEQC=0.0 IF(IOPT.EQ.1)THEN REY=1.E6*SNDDIA*SQRT( 9.8*(SSG-1.)*SNDDIA ) REY=REY**0.6 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 index 22ca78760..8a1778191 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DRIFTER.f90 @@ -45,6 +45,10 @@ SUBROUTINE DRIFTERC ! ******************************************************** REAL(RKD) ::UWIND, VWIND !}GEOSR, 2014.11.25 CWCHO, OIL WIND TRANSFER COEFF. + WINDNN = 0.0_RKD + WINDEE = 0.0_RKD + DIFFVEL = 0.0_RKD + TITLE='PREDICTION OF TRAJECTORIES OF DRIFTERS' !{GEOSR, OIL, CWCHO, 101103 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for index 1d8f71136..e460b0e50 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for @@ -21,6 +21,8 @@ C REAL,ALLOCATABLE,DIMENSION(:)::TXWMAX REAL,ALLOCATABLE,DIMENSION(:)::TXWMIN REAL,ALLOCATABLE,DIMENSION(:,:)::DMPVAL + REAL SCALE + SCALE=0.0 ALLOCATE(CNTTOX(NTXM)) ALLOCATE(DMPVAL(LCM-2,KCM)) ALLOCATE(DMPVALL(LCM-2)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/FSBDLD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/FSBDLD.for index b5681fa97..f02340142 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/FSBDLD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/FSBDLD.for @@ -8,6 +8,7 @@ C C ** CALCULATES DIMNSIONLESS BED LOAD TRANSPORT COEFFICIENT C ** ISOPT=0 USE CONSTANT VALUE C + FSBDLD=0.0 IF(ISOPT.EQ.0) FSBDLD=SBDLDP C C ** ISOPT=1 BASED ON diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index 14e4caf8f..f49b1066b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -42,6 +42,9 @@ C ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 INTEGER ISHYD,IHYDCNT REAL SNAPSHOTHYD + SNAPSHOTHYD=0.0 + IHYDCNT=0 + LN=0 ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 ![ykchoi 10.04.26 for linux version diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index fb8e02426..637b53e95 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -42,7 +42,15 @@ C ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 INTEGER ISHYD,IHYDCNT + INTEGER NTMPVAL + INTEGER ISAVESEDDT + INTEGER LN REAL SNAPSHOTHYD + SNAPSHOTHYD=0.0 + NTMPVAL=0 + IHYDCNT=0 + ISAVESEDDT=0 + LN=0 ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 C ![ykchoi 10.04.26 for linux version diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index f5a68cf34..01d67d425 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -4809,6 +4809,7 @@ C 970 WRITE(6,971) CHARACTER*(*) INLINE CHARACTER*12 CVAL LOGICAL PARSE_LOGICAL + PARSE_LOGICAL=.FALSE. ILEN=LEN_TRIM(INLINE) DO IC=1,ILEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for index 3a0c88e51..407ac9123 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for @@ -79,6 +79,18 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::UJPAVG REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::VJPAVG REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::WJPAVG + REAL WJ0,VJ0,UJ0 + REAL TMPVAL + REAL DYEJET + REAL SFLJET + REAL QSERTAVG + WJ0=0.0 + VJ0=0.0 + UJ0=0.0 + TMPVAL=0.0 + SFLJET=0.0 + DYEJET=0.0 + QSERTAVG=0.0 IF(.NOT.ALLOCATED(DRHONS))THEN PRINT *,'JET/PLUME COMPUTATIONS STARTED. NQJPIJ=',NQJPIJ diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for index 5cbc64725..e01990819 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LUDCMP.for @@ -5,6 +5,8 @@ C PARAMETER (TINY=1.0E-20) DIMENSION A(NP,NP),INDX(N) REAL,ALLOCATABLE,DIMENSION(:)::VV + INTEGER IMAX + IMAX=0 ALLOCATE(VV(N)) C D=1. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for index ba5bd8d95..5a2defa4f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for @@ -6,6 +6,8 @@ C ** SUBROUTINE NEGDEP CHECK EXTERNAL SOLUTION FOR NEGATIVE DEPTHS C USE GLOBAL DIMENSION QCHANUT(NCHANM),QCHANVT(NCHANM) + INTEGER INEGFLG + INEGFLG=0 C C ** CHECK FOR NEGATIVE DEPTHS C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index c1e540215..8885239ea 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -16,6 +16,7 @@ C & JSDAY,JEDAY,JEVDAY,JYEARDAY INTEGER IDTX CHARACTER*20 TXNAME + TXSW=0.0 C C READ TOX EVENT FROM WIMS INFORMATION C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for index 15e6ac768..c9208144c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for @@ -14,6 +14,8 @@ C ** NON-CONVERGENCE IS SIGNALED WHEN THE ITERATIONS EXCEED A C ** MAXIMUM. C USE GLOBAL + REAL RPT + RPT=0.0 RJ2=RP C C PAVG=0.0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for index c46f8c006..0558a1b8a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for @@ -8,6 +8,8 @@ C DIMENSION DBS(10) CHARACTER*80 TITLE DIMENSION CONC(LCM,KCM) + INTEGER LUN + LUN=0 C IF(JSRSPH(ICON).NE.1) GOTO 300 LINES=LA-1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for index 63b5a4939..ebd613886 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for @@ -24,6 +24,8 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XBFO2 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XBFPO4D REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XBFSAD + INTEGER IZA + IZA=0 IF(.NOT.ALLOCATED(IZONE ))THEN ALLOCATE(IZONE(NSMZM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for index 6b9c45a32..c306a1cb2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH.for @@ -10,6 +10,8 @@ C CHARACTER*80 TITLE DIMENSION CONC(LCM,KCM) REAL,ALLOCATABLE,DIMENSION(:)::DBSB + INTEGER LUN + LUN=0 IF(.NOT.ALLOCATED(DBSB)) ALLOCATE(DBSB(0:NSTM)) DBSB=0. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETSTVEL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETSTVEL.for index bda3eafe7..d76559a22 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETSTVEL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETSTVEL.for @@ -1,4 +1,6 @@ FUNCTION SETSTVEL(D,SSG) + REAL WSET + WSET=0.0 C C CHANGE RECORD C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 index 98b85db5c..d9d204618 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 @@ -13,6 +13,10 @@ SUBROUTINE SHOWVAL DATA ISREAD/0/ DATA SCALE/1.0/,UNITS/'PPM'/ + REAL CKB,CKC + CKB=0.0 + CKC=0.0 + IF(ISDYNSTP.EQ.0)THEN DELT=DT ELSE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for index 3cba42624..66bc6a4ae 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for @@ -7,6 +7,9 @@ C ** CALLED FROM CALPUV2TC C USE GLOBAL DIMENSION IACTIVE(NCHANM),QCHANUT(NCHANM),QCHANVT(NCHANM) + REAL HCHNMX,HCHNMN + HCHNMX=0.0 + HCHNMN=0.0 C IF(MDCHH.GE.1)THEN IACTALL=0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SVDCMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SVDCMP.for index da3cc10d9..9635d490f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SVDCMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SVDCMP.for @@ -5,6 +5,9 @@ C CHANGE RECORD C DIMENSION A(MP,NP),W(NP),V(NP,NP) REAL,ALLOCATABLE,DIMENSION(:)::RV1 + INTEGER NM,L + NM=0 + L=0 ALLOCATE(RV1(N)) G=0.0 SCALE=0.0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for index a5c6d52a8..52eef1e7c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Sub_spore.for @@ -7,6 +7,8 @@ C USE GLOBAL INTEGER ICYAM + REAL WQKESS1 + WQKESS1=0.0 ! ITM=(NAT*3600)/(DT*NWQKDPT) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for index f56ba647b..65b346bd4 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TOXCHEM.for @@ -13,6 +13,9 @@ C USE GLOBAL !{GeoSR, 2014.09.16. YSSONG INTEGER::L,K,NT + REAL TXKL,TXKLL + TXKL=0.0 + TXKLL=0.0 !} IF(ISTRAN(5).GE.1)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for index 624d64259..a29de278e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + VALKH=0.0 IF(HFFDG.LE.0.02)THEN VALKH=HFFDG*HFFDG RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for index bacd14670..ecaf49a57 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP5.for @@ -11,6 +11,8 @@ C INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LDTMP INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LUTMP REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QTMP + INTEGER L + L = 0 IF(.NOT.ALLOCATED(LDTMP))THEN ALLOCATE(LDTMP(KCM*LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for index b490ffece..eff8683e7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP6.for @@ -21,6 +21,9 @@ C INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LDTMP INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LUTMP REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QTMP + INTEGER LCLTM2, L + L = 0 + LCLTM2 = 0 IF(.NOT.ALLOCATED(LDTMP))THEN ALLOCATE(LDTMP((KCM+1)*LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for index 3d5972373..9d6a32028 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7.for @@ -22,6 +22,8 @@ C C INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LDTMP INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LUTMP + INTEGER LCLTM2 + LCLTM2 = 0 C IF(.NOT.ALLOCATED(LDTMP))THEN ALLOCATE(LDTMP((KCM+1)*LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for index eda03fe92..3ad8cc88a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WASP7EPA.for @@ -56,6 +56,8 @@ C INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:)::LAUX INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LDTMP INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LUTMP + INTEGER LCLTM2 + LCLTM2 = 0 C IF(.NOT.ALLOCATED(LDTMP))THEN ALLOCATE(LDTMP((KCM+1)*LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 index 50a5ad206..8bcac3a39 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WINDWAVE.f90 @@ -196,6 +196,8 @@ FUNCTION FETZONE(WDIR) RESULT(ZONE) REAL(RKD) ,INTENT(IN )::WDIR ![0,360] INTEGER(4)::ZONE + ZONE=0 + IF (WDIR>337.5 .OR. WDIR <= 22.5) THEN ZONE = 1 ELSEIF (WDIR>22.5 .AND. WDIR <= 67.5) THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for index 694117310..4f9a57ae7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D.for @@ -22,6 +22,10 @@ C Merged SNL and DS-INTL DATA IWQTICI,IWQTAGR,IWQTSTL,IWQTSUN,IWQTBEN,IWQTPSL,IWQTNPL/7*0/ DATA ISMTICI/0/ + REAL SUNSOL01 + REAL SUNFRC02 + SUNSOL01=0.0 + SUNFRC02=0.0 IF(ETIMEDAY.LE.(DTWQ+1.E-8))THEN DAYNEXT=FLOAT(INT(TIMEDAY))+1. !{ GeoSR, YSSONG. 2012/12/15, RESTART diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for index 8de4e921e..6b778d969 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE0.for @@ -17,6 +17,8 @@ C C**********************************************************************C C USE GLOBAL + REAL WQVREA + WQVREA=0.0 C CNS1=2.718 NS=1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for index c096174ca..4c6aacf2d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE1.for @@ -53,6 +53,13 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WQISD REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WQISG + WQF1NM=0.0 + WQTTB=0.0 + WQTTT=0.0 + WQVREA=0.0 + WQTT1=0.0 + L=0 + C ! *** 1) CHC - cyanobacteria ! *** 2) CHD - diatom algae @@ -1875,6 +1882,10 @@ C1414 FORMAT(I12,11E12.4) REAL TSSS_ABOVE,WQCHLS_ABOVE,POMS_ABOVE REAL K_ABOVE + REAL EXPTOP + INTEGER L + L = 0 + EXPTOP=0.0 K=KC IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for index 1e1eefabf..8284ff19b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE2.for @@ -7,6 +7,16 @@ C OPTIMIZED AND MODIFIED BY J.M. HAMRICK C CHANGE RECORD C USE GLOBAL + REAL WQAVGIO, WQF1NM, WQKESS1, WQTT1, WQTTB, WQTTT, WQVREA + INTEGER L + WQAVGIO=0.0 + WQF1NM=0.0 + WQKESS1=0.0 + WQTT1=0.0 + WQTTB=0.0 + WQTTT=0.0 + WQVREA=0.0 + L=0 C CNS1=2.718 NS=1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for index 87f4f7152..62b957e9d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for @@ -22,6 +22,15 @@ C !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 REAL WQFDGSC(2),WQFDGSCX !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + REAL WQVREA,WQTT1,WQTTT,WQF1NM,WQAVGIO,WQTTB,WQA1C + WQVREA=0.0 + WQTTT=0.0 + WQF1NM=0.0 + WQAVGIO=0.0 + WQTTB=0.0 + WQA1C=0.0 + WQTT1=0.0 + CNS1=2.718 NS=1 DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for index 3cef16fdd..4249439b5 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for @@ -30,6 +30,17 @@ C C**********************************************************************C C USE GLOBAL + REAL WQVREA,WQTT1,WQTTT,WQF1NM,WQAVGIO,WQTTB,WQA1C,WQKESS1 + INTEGER L + L = 0 + WQVREA=0.0 + WQTTT=0.0 + WQF1NM=0.0 + WQAVGIO=0.0 + WQTTB=0.0 + WQA1C=0.0 + WQTT1=0.0 + WQKESS1=0.0 C C**********************************************************************C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for index d4208fd61..9b5bb565a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for @@ -63,6 +63,9 @@ C ! GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 CHARACTER*11 FLN CHARACTER*12 FLNX + REAL WQVREA + WQVREA=0.0 + IF(.NOT.ALLOCATED(TNWQMAX))THEN ALLOCATE(TNWQMAX(LCMWQ,KCM)) ALLOCATE(TNWQMIN(LCMWQ,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ZBRENT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ZBRENT.for index fbf45f59c..847b6f449 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ZBRENT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ZBRENT.for @@ -4,12 +4,16 @@ C USING BRENT'S METHOD, FIND THE ROOT OF A FUNC SEDFLUX KNOWN TO LIE C BETWEEN RMIN & RMAX WITHIN AN ACCURACY OF TOL (P. 253 IN NUMERICAL C RECIPE). C + REAL A,B,C,D,E EXTERNAL SEDFLUX PARAMETER (IZMAX=100,EPS=3.0E-8,TOL=1.0E-5, & RMIN=1.0E-4,RMAX=100.0) ISMERR = 0 A = RMIN B = RMAX + C = 0.0 + D = 0.0 + E = 0.0 FA = SEDFLUX(A) FB = SEDFLUX(B) ZBRENT = 0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for index cd7825e9d..b0162323c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for @@ -64,6 +64,8 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::FDCHTXBC REAL,ALLOCATABLE,DIMENSION(:,:)::FDCHTXBP REAL,ALLOCATABLE,DIMENSION(:,:)::FDCHTXBD + INTEGER JSFDCH + JSFDCH=0 C IF(.NOT.ALLOCATED(KBFC))THEN ALLOCATE(KBFC(LCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 index 9d7153e17..f96deb65d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_shear.f90 @@ -15,6 +15,9 @@ SUBROUTINE SEDZLJ_SHEAR DOUBLE PRECISION::FWINDS,FWINDD DOUBLE PRECISION::TDIFF,WTM1,WTM2,AVGDEPTH DOUBLE PRECISION,DIMENSION(LCM)::ZBTEMP + VELANG=0.0 + WVANGLE=0.0 + FZONE=0 ! CALCULATES Wave and Current Shear Stress Based on Log-Law of Cristofferson Jonsson ! From 02c772c83a01d9a3d5b5bc46c00f3bbfe3701953 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Wed, 13 Dec 2023 14:09:23 +0100 Subject: [PATCH 14/77] Revert "Resolve warning infinite loop on READ branch" This reverts commit 3dceaaf91adc5f7c1ad24e7cf2ed2be1aa81739c. --- .../efdc_fortran_dll/original_efdc_files/SCANASER.for | 6 +----- .../efdc_fortran_dll/original_efdc_files/SCANDSER.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANGWSR.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANMODC.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANPSER.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANQSER.for | 10 ++-------- .../efdc_fortran_dll/original_efdc_files/SCANSFSR.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANSSER.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANTSER.for | 5 +---- .../efdc_fortran_dll/original_efdc_files/SCANWQ.for | 11 ++--------- .../efdc_fortran_dll/original_efdc_files/SCANWSER.for | 5 +---- 11 files changed, 13 insertions(+), 54 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for index d5be045a2..5daa22131 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for @@ -1,15 +1,11 @@ SUBROUTINE SCANASER USE GLOBAL CHARACTER*120 LIN - INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: ASER.INP' OPEN(1,FILE='ASER.INP',STATUS='OLD') DO N=1,NASER - IOS=1 - DO WHILE (IOS > 0) - READ(1,*,IOSTAT=IOS,END=40)M,R,R,I,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)M,R,R,I,R,R,R,R READ(1,*,ERR=20,END=40)I,R,R,R,R,R,R,R,R,R NDASER=MAX(NDASER,M) DO I=1,M diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for index 3759e587c..59d7e011f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: DSER.INP' OPEN(1,FILE='DSER.INP',STATUS='OLD') DO NS=1,NCSER3 - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for index b018aef89..c3c1602e9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for @@ -5,10 +5,7 @@ INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: GWSER.INP' OPEN(1,FILE='GWSER.INP',STATUS='OLD') - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)NGWSER - ENDDO + 10 READ(1,*,ERR=10,END=40)NGWSER NGWSERM=MAX(1,NGWSER) DO NS=1,NGWSER READ(1,*,ERR=20,END=40)M,R,R,R,R diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for index 8e9f33ee7..af6580bf2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for @@ -3,10 +3,7 @@ INTEGER IOS WRITE(*,'(A)')'SCANNING INPUT FILE: MODCHAN.INP' OPEN(1,FILE='MODCHAN.INP',STATUS='OLD') - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)M,I,I - ENDDO + 10 READ(1,*,ERR=10,END=40)M,I,I NCHANM=MAX(1,M) READ(1,*,ERR=20,END=40)I,I,R CLOSE(1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for index 9bf524856..5dbcd60d8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: PSER.INP' OPEN(1,FILE='PSER.INP',STATUS='OLD') DO NS=1,NPSER - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)M,R,R,R,R NDPSER=MAX(NDPSER,M) DO I=1,M READ(1,*,ERR=20,END=40)R,R diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for index ea8d71af8..0a89d5561 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for @@ -6,10 +6,7 @@ OPEN(1,FILE='QSER.INP',STATUS='OLD') DO NS=1,NQSER - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R,J - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R,J NDQSER=MAX(NDQSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) @@ -59,10 +56,7 @@ C ***************************************************************************** OPEN(1,FILE='QWRS.INP',STATUS='OLD') DO NS=1,NQWRSR - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R NDQWRSR=MAX(NDQWRSR,M) IF(I.EQ.0)THEN ! *** Flow Only diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for index 0fc0e127f..27cf071c7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: SFSER.INP' OPEN(1,FILE='SFSER.INP',STATUS='OLD') DO NS=1,NCSER4 - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for index 2dbe453f9..f31f47e4a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: SSER.INP' OPEN(1,FILE='SSER.INP',STATUS='OLD') DO NS=1,NCSER1 - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for index 9908ef7a2..ea1260a1b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: TSER.INP' OPEN(1,FILE='TSER.INP',STATUS='OLD') DO NS=1,NCSER2 - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)I,M,R,R,R,R - ENDDO + 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R NDCSER=MAX(NDCSER,M) IF(I.EQ.1)THEN READ(1,*,ERR=20,END=40)(R,K=1,KC) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for index 5501b6723..6291e507c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for @@ -11,7 +11,6 @@ LOGICAL*4 BFLAG INTEGER*4 I,J,K,ITMP,NW REAL*4 XPSQ - INTEGER IOS LOGICAL fileExists WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP' @@ -86,10 +85,7 @@ C READ(1,1) ENDDO DO NS=1,NPSTMSR - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=20)M,TM,TA,RMULADJ,ADDADJ - ENDDO + 10 READ(1,*,ERR=10,END=20)M,TM,TA,RMULADJ,ADDADJ NDWQPSR=MAX(NDWQPSR,M) DO J=1,M !READ(1,*)T,(RLDTMP(K),K=1,NWQV) @@ -120,10 +116,7 @@ C READ(1,1) ENDDO DO NS=1,1000 - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)ISTYP,M,T1,T2,RMULADJ,ADDADJ - ENDDO + 30 READ(1,*,ERR=30,END=40)ISTYP,M,T1,T2,RMULADJ,ADDADJ IF(ISTYP.EQ.1) READ(1,*) ! GeoSR, 2014.10.13 JHLEE, CWQSR SCANNING diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for index b236d3adc..a8235f1ec 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for @@ -4,10 +4,7 @@ WRITE(*,'(A)')'SCANNING INPUT FILE: WSER.INP' OPEN(1,FILE='WSER.INP',STATUS='OLD') DO NS=1,NWSER - IOS=1 - DO WHILE (IOS>0) - READ(1,*,IOSTAT=IOS,END=40)M,R,R,R,I - ENDDO + 10 READ(1,*,ERR=10,END=40)M,R,R,R,I NDWSER=MAX(NDWSER,M) DO I=1,M READ(1,*,ERR=20,END=40)R,R,R From e511c5e9600f6e685ce591bae678cdf7a5a53626 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 17:42:43 +0100 Subject: [PATCH 15/77] Transfer growth limit and algal rate prints --- .../original_efdc_files/Var_Global_Mod.f90 | 46 +++++++++++++++++++ .../original_efdc_files/WQ3DINP.for | 3 +- 2 files changed, 47 insertions(+), 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 index ce0a93b04..237870124 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 @@ -3925,5 +3925,51 @@ MODULE GLOBAL REAL,ALLOCATABLE::WQSALAX(:) REAL,ALLOCATABLE::WQSALBX(:) !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + + REAL*8,ALLOCATABLE,DIMENSION(:)::APCG_R8 + REAL*8,ALLOCATABLE,DIMENSION(:)::PCG_R8 + REAL*8,ALLOCATABLE,DIMENSION(:)::RCG_R8 + + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CLOUDTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EVAPTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PATMTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RAINTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RHAT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SOLSWRTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVPAT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TATMTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TWETTT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::VPAT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDE + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDN + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXX + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXY + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYX + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYY + + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:,:) :: DZCB_2D + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:,:) :: BK_2D + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:) :: DBK_1D + + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:) :: SHEAR_1D,HBED_1D,BDENBED_1D,PORBED_1D + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:,:) :: SEDB_1D,SED_VFRBED_1D + REAL*4,SAVE,ALLOCATABLE,DIMENSION(:,:) :: SNDB_1D,SND_VFRBED_1D + INTEGER*4,SAVE,ALLOCATABLE,DIMENSION(:):: N1_1D + INTEGER :: ITIMING,IBIN_TYPE + REAL*4 :: SOLARAVG + REAL*8 :: SOLARAVG_R8 + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: CLOE_TMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: CLON_TMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: CLOS_TMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: CLOW_TMP + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: NLOE_TMP + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: NLON_TMP + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: NLOS_TMP + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:,:,:) :: NLOW_TMP + + REAL,ALLOCATABLE,DIMENSION(:,:,:)::CSERT_TMP,CSERT_SUM + LOGICAL :: PRINT_SUM + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for index d8927e011..1c72a41af 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for @@ -187,7 +187,6 @@ C ! *** READ WQ TIMESERIES CALL RWQCSR C - !{GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 IF(IWQTS.GE.1)THEN IF(ISCOMP .EQ. 3. OR. ISCOMP .EQ. 4)THEN @@ -209,7 +208,7 @@ C ENDIF ENDIF !}GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 - 100 FORMAT(' TIME = ',A11,' HH.MM.SS.HH') +C 100 FORMAT(' TIME = ',A11,' HH.MM.SS.HH') RETURN END From 609b5aa801f8fffa6728e69ac725cd94aea8740b Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 17:57:15 +0100 Subject: [PATCH 16/77] Match uppercase between implementations --- .../efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 index 237870124..2d5460bbf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 @@ -22,7 +22,7 @@ ! ** MODULE GLOBAL ! - Integer, PARAMETER :: NTSWQVM=23 !VB NTSWQVM CHANGED FROM 22 TO 23 TO ACCOMODATE CO2 + INTEGER, PARAMETER :: NTSWQVM=23 !VB NTSWQVM CHANGED FROM 22 TO 23 TO ACCOMODATE CO2 REAL, PARAMETER :: EPS=1e-8 ! CHARACTER*50 AGRFN From f5d2d4239e45c5e66f8e3d476361d50d7fb8c169 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 17:57:31 +0100 Subject: [PATCH 17/77] Drop unused variables and subroutine CALEBI0 Some of these are old loop variables that were not removed when the corresponding parallel loops were stripped out. Others are simply additional unused variables. --- .../original_efdc_files/BAL2T3B.for | 1 - .../original_efdc_files/BAL2T4.for | 2 +- .../original_efdc_files/CALAVB.for | 2 +- .../original_efdc_files/CALCONC.for | 1 - .../original_efdc_files/CALEBI.for | 47 ------------------- .../original_efdc_files/CALEXP2T.for | 1 - .../original_efdc_files/CALTBXY.for | 2 - .../original_efdc_files/CALTRAN.for | 8 ---- .../original_efdc_files/HDMT.for | 3 -- .../original_efdc_files/Var_Global_Mod.f90 | 2 +- 10 files changed, 3 insertions(+), 66 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for index 028318e00..5ec4eb20a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for @@ -10,7 +10,6 @@ C USE GLOBAL IMPLICIT NONE INTEGER::LUTMP,LDTMP,L,K,NSX,NSB,IBALSTDT,NT,M - INTEGER::LF,LL,ithds IF(ISDYNSTP.EQ.0)THEN DELT=DT ELSE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for index 857fcdd9e..6e398a053 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T4.for @@ -7,7 +7,7 @@ C ** AND ENERGY BALANCES C USE GLOBAL IMPLICIT NONE - INTEGER::L,LN,K,LF,LL,ithds + INTEGER::L,LN,K REAL::DUTMP,DVTMP IF(ISDYNSTP.EQ.0)THEN DELT=DT diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for index ac5afa2d1..a00eaf284 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB.for @@ -9,7 +9,7 @@ C ADDED DRYCELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES C USE GLOBAL IMPLICIT NONE - INTEGER::L,K,LS,ISTL_,LF,LL,ithds + INTEGER::L,K,LS,ISTL_ REAL::QQIMAX,RIQMIN,RIQMAX,RIQ,SFAV,SFAB,ABTMP,AVTMP C C SHTOP = 0.4939 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 2e5d6be84..692da0117 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -16,7 +16,6 @@ C REAL::TTMP,RCDZKMK,CONASMOLD,SALASM, T1TMP,T2TMP REAL::TEMASM,DYEASM,SFLASM,RCDZKK,CCUBTMP,CCMBTMP REAL::DELTD2,CDYETMP,TMP,DAGE - INTEGER::LF_LC,LL_LC,ithds REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EEB REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CCLBTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for index a36c22363..60d01b215 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI.for @@ -1,50 +1,3 @@ - SUBROUTINE CALEBI0(LF,LL) -C -C CHANGE RECORD -C ** CALEBI CALCULATES THE EXTERNAL BUOYANCY INTEGRALS -C - USE GLOBAL - IMPLICIT NONE - INTEGER::K,L,IPMC,LLCM,LF,LL - REAL::EPSILON,DBK,DZCBK - - REAL*4 DZCB(KCM) - REAL*4 BK(KCM) - - PARAMETER(LLCM=200) - REAL*4 BI1T(LLCM) - REAL*4 BI2T(LLCM) - REAL*4 BET(LLCM) - - DO L=LF,LL - - BI1(L)=0. - BI2(L)=0. - BE(L)=0. - - DO K=1,KC - DZCB(K)=DZC(K)*B(L,K) - ENDDO - - DBK=0. - DO K=KC,1,-1 - DBK=DBK+DZCB(K) !DZC(K)*B(L,K) - BK(K)=DBK-0.5*DZCB(K) !DZC(K)*B(L,K) - ENDDO - - !Z(0)=0. - !Z(K)=Z(K-1)+DZC(K) - DO K=1,KC - BE(L) =BE(L)+DZCB(K) !DZC(K)*B(L,K) - DZCBK =DZC(K)*BK(K) - BI1(L)=BI1(L)+DZCBK - BI2(L)=BI2(L)+(DZCBK+0.5*(Z(K)+Z(K-1))*DZCB(K)) - ENDDO - - ENDDO - - RETURN - END SUBROUTINE CALEBI C C CHANGE RECORD diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for index 47f8dfd18..fc674ac93 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T.for @@ -21,7 +21,6 @@ C USE GLOBAL IMPLICIT NONE - INTEGER::LF,ithds INTEGER::L,K,LN,LS,ID,JD,KD,NWR,IU,JU,KU,LU,NS,LNW,LSE,LL INTEGER::LD,NMD,LHOST,LCHNU,LW,LE,LCHNV REAL::TMPANG,WU,WV,CACSUM,CFEFF,VEAST2,VWEST2,FCORE,FCORW diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for index 2d74be421..ff2c04c03 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY.for @@ -34,8 +34,6 @@ C REAL::BOTTMP,DWVDHR,DWUDHR,QWCTMPV,QWCTMPU REAL::CDTMPV,CDTMPU,COSWC,CURANG,CDTMPUX REAL::WVDELV,WVDELU,TAUTMP - INTEGER::LF,LL,ithds - REAL::t00,rtc LZBMIN=0 LZBMAX=0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index 5a83ad18b..c338d7554 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -10,9 +10,6 @@ C USE GLOBAL REAL, DIMENSION(LCM,KCM), intent(inout) :: CON,CON1 - REAL, DIMENSION(:,:), allocatable :: UTERM0, VTERM0, - + SSCORUEWNS, SSCORWAB - INTEGER, dimension(0:nthds-1,KC) :: icount REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMN REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMX @@ -24,11 +21,6 @@ C REAL CTMP CTMP=0.0 - ALLOCATE(UTERM0(LC,KC)) - ALLOCATE(VTERM0(LC,KC)) - ALLOCATE(SSCORUEWNS(LC,KC)) - ALLOCATE(SSCORWAB(LC,KC)) - IF(.NOT.ALLOCATED(CONTMN))THEN ALLOCATE(CONTMN(0:LCM1,KCM)) ALLOCATE(CONTMX(0:LCM1,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for index f49b1066b..5afc00b38 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT.for @@ -35,9 +35,6 @@ C INTRINSIC ISNAN LOGICAL ISNAN - INTEGER::ithds - - REAL :: SECNDS ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 INTEGER ISHYD,IHYDCNT diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 index 2d5460bbf..536a49176 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 @@ -3793,7 +3793,7 @@ MODULE GLOBAL INTEGER(4) ::maxprocs,maxprocs1 parameter(maxprocs=64,maxprocs1=maxprocs-1) - INTEGER(4) ::nthds, jse(2,0:maxprocs1),jse_LC(2,0:maxprocs1),jse_2_LC(2,0:maxprocs1),jse_LC1(2,0:maxprocs1) + INTEGER(4) ::nthds, jse(2,0:maxprocs1),jse_LC(2,0:maxprocs1),jse_2_LC(2,0:maxprocs1) !{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. INTEGER::ISWIND From c1e385441f74664351dbcddea203e8c162e53e4a Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 18:05:57 +0100 Subject: [PATCH 18/77] Match format statement with NIER --- .../native/efdc_fortran_dll/original_efdc_files/CALCONC.for | 2 +- .../native/efdc_fortran_dll/original_efdc_files/CALPSER.for | 4 +--- .../efdc_fortran_dll/original_efdc_files/SCANGATECTL.for | 6 ++++-- .../native/efdc_fortran_dll/original_efdc_files/SMRIN1.for | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for index 692da0117..c16e39a85 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC.for @@ -937,7 +937,7 @@ C ENDDO ENDIF C -C6222 FORMAT(' TC,SNEW,SASSM,SOLD=',4F10.2) +C6222 FORMAT(' TC,SNEW,SASSM,SOLD='4F10.2) C IF(ISCDA(7).GT.0)THEN DO NX=1,NSND diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for index 90e04c5a3..e3d98fe12 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for @@ -39,9 +39,7 @@ C ENDIF 1001 FORMAT(/' TRANSPORT VARIABLE ID =',I5/) 1002 FORMAT(I5,2X,12E12.4) - - - 6000 FORMAT('N, PSERT = ',I6,4X,F12.4) +C6000 FORMAT('N, PSERT = ',I6,4X,F12.4) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for index dcd68b0b3..45a8b746e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for @@ -26,8 +26,10 @@ ! { GEOSR 2014.11.12 UNG Warning message writing OPEN(1,FILE='GateWarning.LOG',STATUS='UNKNOWN') ! GEOSR UNG 2014.11.12 Warning message writing CLOSE(1,STATUS='DELETE') ! GEOSR UNG 2014.11.12 Warning message writing - OPEN(713,FILE='GateWarning.LOG',STATUS='UNKNOWN') ! GEOSR UNG 2014.11.12 Warning message writing - WRITE(713,'(A)')'TIME N NCTL IQCTLU JQCTLU QSUM CellVOL' + OPEN(713,FILE='GateWarning.LOG',STATUS='UNKNOWN') ! GEOSR UNG 2014.11.12 Warning message writing + WRITE(713,'(A)') + & 'TIME N NCTL IQCTLU JQCTLU QSUM CellVOL' + CLOSE(1) ! } GEOSR 2014.11.12 UNG Warning message writing RETURN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for index 441cdd800..bd7e91a4a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for @@ -183,7 +183,7 @@ C PMC & STOP 'ERROR!! ISMTSDT SHOULD BE MULTIPLE OF IWQDT' C5104 FORMAT(I8, 3F8.4) 50 FORMAT(A50) 51 FORMAT(A27, 3(F8.4,2X)) - 52 FORMAT((A45, E10.4)) + 52 FORMAT((A45, E11.4)) 53 FORMAT((A48, I10)) C 55 FORMAT(A31, 2I5) 84 FORMAT(3(A26,F10.4,A5,/), 2(A26,I8,A10,/)) From 103f940d1237d8e58a155ba867b1577e1b928b00 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 30 Nov 2023 18:34:38 +0100 Subject: [PATCH 19/77] Comment variable definitions to match NIER These are commented here and seem unused. --- .../original_efdc_files/CALTSXY.for | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for index 6ff3ac146..20d72f46c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY.for @@ -4,22 +4,22 @@ C CHANGE RECORD C ** SUBROUTINE CALTSXY UPDATES TIME VARIABLE SURFACE WIND STRESS C USE GLOBAL - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CLOUDTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EVAPTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PATMTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RAINTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RHAT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SOLSWRTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVPAT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TATMTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TWETTT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::VPAT - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDE - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDN - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXX - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXY - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYX - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYY +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CLOUDTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EVAPTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PATMTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RAINTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RHAT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SOLSWRTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVPAT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TATMTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TWETTT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::VPAT +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDE +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDN +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXX +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXY +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYX +C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYY C IF(.NOT.ALLOCATED(CLOUDTT))THEN ALLOCATE(CLOUDTT(NASERM)) From a07100fef1a204af798f288968c9c7ddec985987 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Fri, 1 Dec 2023 10:58:50 +0100 Subject: [PATCH 20/77] Initialise local variables --- .../native/efdc_fortran_dll/original_efdc_files/COSTRANW.for | 3 +++ .../native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for index 31cd23130..0afbb6542 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for @@ -52,6 +52,9 @@ C REAL CSTARP REAL CSTARN REAL CTMP + CSTARP=0.0 + CSTARN=0.0 + CTMP=0.0 IF(.NOT.ALLOCATED(CONCX))THEN ALLOCATE(CONCX(LCM,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 index a49ac1e5a..2029375a6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/s_sedzlj.f90 @@ -15,6 +15,10 @@ SUBROUTINE SEDZLJ(L) INTEGER CRAIG INTEGER SURFACE + NTAU0=0 + NTAU1=0 + NSC0=0 + NSC1=0 IF(IS_TIMING)THEN CALL CPU_TIME(T1TMP) From 5a26a8930ddd7a0271aaa2b214dad830ab3d4899 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 13:49:20 +0100 Subject: [PATCH 21/77] Add MPI-based subroutine implementations The filenames '${NAME}_mpi.for' implement the MPI counter parts of the subroutines present in '${NAME}.for'. --- .../original_efdc_files/CALAVBOLD_mpi.for | 233 ++ .../original_efdc_files/CALAVB_mpi.for | 225 ++ .../original_efdc_files/CALBUOY_mpi.for | 202 ++ .../original_efdc_files/CALCONC_mpi.for | 1160 +++++++ .../original_efdc_files/CALCSER_mpi.for | 358 +++ .../original_efdc_files/CALDIFF_mpi.for | 30 + .../original_efdc_files/CALEBI_mpi.for | 97 + .../original_efdc_files/CALEXP2T_mpi.for | 1338 ++++++++ .../original_efdc_files/CALFQC_mpi.for | 1329 ++++++++ .../original_efdc_files/CALHDMF_mpi.for | 342 +++ .../original_efdc_files/CALHEAT_mpi.for | 792 +++++ .../original_efdc_files/CALMMT_mpi.for | 992 ++++++ .../original_efdc_files/CALPNHS_mpi.for | 209 ++ .../original_efdc_files/CALPSER_mpi.for | 39 + .../original_efdc_files/CALPUV2C_mpi.for | 1485 +++++++++ .../original_efdc_files/CALQQ2TOLD_mpi.for | 691 +++++ .../original_efdc_files/CALQQ2T_mpi.for | 664 ++++ .../original_efdc_files/CALQVS_mpi.for | 753 +++++ .../original_efdc_files/CALSFT_mpi.for | 354 +++ .../original_efdc_files/CALTBXY_mpi.for | 795 +++++ .../original_efdc_files/CALTRAN_mpi.for | 1788 +++++++++++ .../original_efdc_files/CALTSXY_mpi.for | 455 +++ .../original_efdc_files/CALUVW_mpi.for | 791 +++++ .../original_efdc_files/CALVEGSER_mpi.for | 61 + .../original_efdc_files/CALWQC_mpi.for | 507 +++ .../original_efdc_files/CONGRAD_mpi.for | 226 ++ .../original_efdc_files/EEXPOUT_mpi.for | 844 +++++ .../original_efdc_files/HDMT2T_mpi.for | 2713 +++++++++++++++++ .../original_efdc_files/RWQATM_mpi.for | 47 + .../original_efdc_files/SALPLTH_mpi.for | 589 ++++ .../original_efdc_files/SALTSMTH_mpi.for | 93 + .../original_efdc_files/SETBCS_mpi.for | 866 ++++++ .../original_efdc_files/VELPLTH_mpi.for | 402 +++ .../original_efdc_files/WQ3D_mpi.for | 635 ++++ .../original_efdc_files/WQSKE3_mpi.for | 2611 ++++++++++++++++ 35 files changed, 24716 insertions(+) create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDIFF_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALVEGSER_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETBCS_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VELPLTH_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3_mpi.for diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD_mpi.for new file mode 100644 index 000000000..9386ae2bd --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVBOLD_mpi.for @@ -0,0 +1,233 @@ + SUBROUTINE CALAVBOLD_mpi (ISTL_) +C +C *** OLD STANDARD +C +C ** SUBROUTINE CALAV CALCULATES VERTICAL VISCOSITY AND DIFFUSIVITY +C ** USING GLAPERIN ET AL'S MODIFICATION OF THE MELLOR-YAMADA MODEL +C ** (NOTE AV, AB, AND AQ ARE ACTUALLY DIVIDED BY H) +C ** IF ISGA=1 VALUES ARE GEOMETRIC AVERAGES WITH THE PREVIOUS VALUES +C CHANGE RECORD +C ADDED DRYCELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES +C + USE GLOBAL + USE MPI + IMPLICIT NONE + REAL::QQIMAX,RIQMIN,RIQMAX,RIQ + REAL::SFAV,SFAB,ABTMP,AVTMP + INTEGER::K,L,LS,ISTL_ +C SMTOP2 = 7.8464 +C SMBOT1 = 34.6764 +C SMBOT2 = 6.1272 +C RLIMIT = 0.0233 +C SHMIN = 0.0934 +C SMMIN = 0.1099 +C SHMAX = 5.2073 +C SMMAX = 4.9639 +C + QQIMAX=1./QQMIN + AVMAX=AVO + ABMAX=ABO + AVMIN=10. + ABMIN=10. + RIQMIN=-0.023 + RIQMAX=0.28 + + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + IF(IMASKDRY(L).EQ.1)THEN + AV(L,K)=AVO*HPI(L) + AB(L,K)=ABO*HPI(L) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(801)=MPI_WTIMES(801)+MPI_TOC(S1TIME) + + IF(ISFAVB.EQ.0)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,AVMAX,ABMAX,AVMIN,ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) +C +C SFAV=0.4*(1.+8.*RIQ)/((1.+36.*RIQ)*(1.+6.*RIQ)) +C SFAB=0.5/(1.+36.*RIQ) +C + SFAV=0.3933*(1.+7.8464*RIQ)/((1.+34.6764*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+34.6764*RIQ) + AB(L,K)=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AV(L,K)=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AV(L,K)) + ABMAX=MAX(ABMAX,AB(L,K)) + AVMIN=MIN(AVMIN,AV(L,K)) + ABMIN=MIN(ABMIN,AB(L,K)) + AV(L,K)=AV(L,K)*HPI(L) + AB(L,K)=SCB(L)*AB(L,K)*HPI(L) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(802)=MPI_WTIMES(802)+MPI_TOC(S1TIME) + ENDIF + + IF(ISFAVB.EQ.1)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,ABTMP,AVTMP,AVMAX,ABMAX,AVMIN, +!$OMP+ ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) +C +C SFAV=0.4*(1.+8.*RIQ)/((1.+36.*RIQ)*(1.+6.*RIQ)) +C SFAB=0.5/(1.+36.*RIQ) +C + SFAV=0.3933*(1.+7.8464*RIQ)/((1.+34.6764*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+34.6764*RIQ) + ABTMP=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AVTMP=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AVTMP) + ABMAX=MAX(ABMAX,ABTMP) + AVMIN=MIN(AVMIN,AVTMP) + ABMIN=MIN(ABMIN,ABTMP) + AV(L,K)=0.5*(AV(L,K)+AVTMP*HPI(L)) + AB(L,K)=SCB(L)*0.5*(AB(L,K)+ABTMP*HPI(L)) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(803)=MPI_WTIMES(803)+MPI_TOC(S1TIME) + ENDIF + IF(ISFAVB.EQ.2)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,ABTMP,AVTMP, +!$OMP+ AVMAX,ABMAX,AVMIN,ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) +C +C SFAV=0.4*(1.+8.*RIQ)/((1.+36.*RIQ)*(1.+6.*RIQ)) +C SFAB=0.5/(1.+36.*RIQ) +C + SFAV=0.3933*(1.+7.8464*RIQ)/((1.+34.6764*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+34.6764*RIQ) + ABTMP=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AVTMP=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AVTMP) + ABMAX=MAX(ABMAX,ABTMP) + AVMIN=MIN(AVMIN,AVTMP) + ABMIN=MIN(ABMIN,ABTMP) + AV(L,K)=SQRT(AV(L,K)*AVTMP*HPI(L)) + AB(L,K)=SCB(L)*SQRT(AB(L,K)*ABTMP*HPI(L)) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(804)=MPI_WTIMES(804)+MPI_TOC(S1TIME) + ENDIF + S1TIME=MPI_TIC() + IF(ISAVBMX.GE.1)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(AVTMP,ABTMP) + DO L=LMPI2,LMPILA + AVTMP=AVMX*HPI(L) + ABTMP=ABMX*HPI(L) + AV(L,K)=MIN(AV(L,K),AVTMP) + AB(L,K)=MIN(AB(L,K),ABTMP) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(805)=MPI_WTIMES(805)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(AV,ic) + CALL broadcast_boundary_array(AB,ic) + MPI_WTIMES(809)=MPI_WTIMES(809)+MPI_TOC(S1TIME) + + if(PRINT_SUM)then + call collect_in_zero_array(B ) + call collect_in_zero_array(QQSQR ) + call collect_in_zero_array(AV ) + call collect_in_zero_array(AB ) + IF(MYRANK.EQ.0) PRINT*, 'B = ', sum(abs(dble(B))) + IF(MYRANK.EQ.0) PRINT*, 'QQSQR = ', sum(abs(dble(QQSQR))) + IF(MYRANK.EQ.0) PRINT*, 'AV = ', sum(abs(dble(AV))) + IF(MYRANK.EQ.0) PRINT*, 'AB = ', sum(abs(dble(AB))) + endif + + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + AVUI(L,K)=2./(AV(L,K)+AV(L-1,K)) + AVVI(L,K)=2./(AV(L,K)+AV(LS,K)) + ENDDO + ENDDO + MPI_WTIMES(806)=MPI_WTIMES(806)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AQ(L,K)=0.205*(AV(L,K-1)+AV(L,K)) + ENDDO + ENDDO + MPI_WTIMES(807)=MPI_WTIMES(807)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AQ(L,1)=0.205*AV(L,1) + AQ(L,KC)=0.205*AV(L,KS) + ENDDO + MPI_WTIMES(808)=MPI_WTIMES(808)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(AQ,ic) + CALL broadcast_boundary_array(AVUI,ic) + CALL broadcast_boundary_array(AVVI,ic) + MPI_WTIMES(810)=MPI_WTIMES(810)+MPI_TOC(S1TIME) + + + if(PRINT_SUM)then + call collect_in_zero_array(AVUI ) + call collect_in_zero_array(AVVI ) + IF(MYRANK.EQ.0) PRINT*, 'avb_AVUI = ', sum(abs(dble(AVUI))) + IF(MYRANK.EQ.0) PRINT*, 'avb_AVVI = ', sum(abs(dble(AVVI))) + endif + + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB_mpi.for new file mode 100644 index 000000000..46ea31b10 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALAVB_mpi.for @@ -0,0 +1,225 @@ + SUBROUTINE CALAVB_mpi (ISTL_) +C +C ** SUBROUTINE CALAV CALCULATES VERTICAL VISCOSITY AND DIFFUSIVITY +C ** USING GLAPERIN ET AL'S MODIFICATION OF THE MELLOR-YAMADA MODEL +C ** (NOTE AV, AB, AND AQ ARE ACTUALLY DIVIDED BY H) +C ** IF ISGA=1 VALUES ARE GEOMETRIC AVERAGES WITH THE PREVIOUS VALUES +C CHANGE RECORD +C ADDED DRYCELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES +C + USE GLOBAL + USE MPI + IMPLICIT NONE + INTEGER::L,K,LS,ISTL_ + REAL::QQIMAX,RIQMIN,RIQMAX,RIQ,SFAV,SFAB,ABTMP,AVTMP +C +C SHTOP = 0.4939 +C SHBOT = 34.6764 +C SMTOP1 = 0.3933 +C SMTOP2 = 7.8464 +C SMBOT1 = 34.6764 +C SMBOT2 = 6.1272 +C RLIMIT = 0.0233 +C SHMIN = 0.0934 +C SMMIN = 0.1099 +C SHMAX = 5.2073 +C SMMAX = 4.9639 +C + QQIMAX=1./QQMIN + AVMAX=AVO + ABMAX=ABO + AVMIN=10. + ABMIN=10. + RIQMIN=-0.023 + RIQMAX=0.28 + + S1TIME=MPI_TIC() +C DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + IF(IMASKDRY(L).EQ.1)THEN + AV(L,1:KC)=AVO*HPI(L) + AB(L,1:KC)=ABO*HPI(L) + ENDIF + ENDDO +C ENDDO + MPI_WTIMES(801)=MPI_WTIMES(801)+MPI_TOC(S1TIME) + + IF(ISFAVB.EQ.0)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,AVMAX,ABMAX,AVMIN,ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) + SFAV=0.3920*(1.+8.6736*RIQ)/((1.+30.192*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+30.192*RIQ) + AB(L,K)=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AV(L,K)=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AV(L,K)) + ABMAX=MAX(ABMAX,AB(L,K)) + AVMIN=MIN(AVMIN,AV(L,K)) + ABMIN=MIN(ABMIN,AB(L,K)) + AV(L,K)=AV(L,K)*HPI(L) + AB(L,K)=SCB(L)*AB(L,K)*HPI(L) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(802)=MPI_WTIMES(802)+MPI_TOC(S1TIME) + ENDIF + + IF(ISFAVB.EQ.1)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,ABTMP,AVTMP,AVMAX, +!$OMP+ ABMAX,AVMIN,ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) + SFAV=0.3920*(1.+8.6736*RIQ)/((1.+30.192*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+30.192*RIQ) + ABTMP=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AVTMP=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AVTMP) + ABMAX=MAX(ABMAX,ABTMP) + AVMIN=MIN(AVMIN,AVTMP) + ABMIN=MIN(ABMIN,ABTMP) + AV(L,K)=0.5*(AV(L,K)+AVTMP*HPI(L)) + AB(L,K)=SCB(L)*0.5*(AB(L,K)+ABTMP*HPI(L)) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(803)=MPI_WTIMES(803)+MPI_TOC(S1TIME) + ENDIF + IF(ISFAVB.EQ.2)THEN + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQI(L)=1./QQ(L,K) + QQI(L)=MIN(QQI(L),QQIMAX) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(RIQ,SFAV,SFAB,ABTMP,AVTMP, +!$OMP+ AVMAX,ABMAX,AVMIN,ABMIN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + RIQ=-GP*HP(L)*DML(L,K)*DML(L,K)*DZIG(K) + & *(B(L,K+1)-B(L,K))*QQI(L) + RIQ=MAX(RIQ,RIQMIN) + RIQ=MIN(RIQ,RIQMAX) + SFAV=0.3920*(1.+8.6736*RIQ)/((1.+30.192*RIQ)*(1.+ + & 6.1272*RIQ)) + SFAB=0.4939/(1.+30.192*RIQ) + ABTMP=AVCON*SFAB*DML(L,K)*HP(L)*QQSQR(L,K)+ABO + AVTMP=AVCON*SFAV*DML(L,K)*HP(L)*QQSQR(L,K)+AVO + AVMAX=MAX(AVMAX,AVTMP) + ABMAX=MAX(ABMAX,ABTMP) + AVMIN=MIN(AVMIN,AVTMP) + ABMIN=MIN(ABMIN,ABTMP) + AV(L,K)=SQRT(AV(L,K)*AVTMP*HPI(L)) + AB(L,K)=SCB(L)*SQRT(AB(L,K)*ABTMP*HPI(L)) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(804)=MPI_WTIMES(804)+MPI_TOC(S1TIME) + ENDIF + S1TIME=MPI_TIC() + IF(ISAVBMX.GE.1)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(AVTMP,ABTMP) + DO L=LMPI2,LMPILA + AVTMP=AVMX*HPI(L) + ABTMP=ABMX*HPI(L) + AV(L,K)=MIN(AV(L,K),AVTMP) + AB(L,K)=MIN(AB(L,K),ABTMP) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(805)=MPI_WTIMES(805)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(AV,ic) + CALL broadcast_boundary_array(AB,ic) + MPI_WTIMES(809)=MPI_WTIMES(809)+MPI_TOC(S1TIME) + + if(PRINT_SUM)then + call collect_in_zero_array(B ) + call collect_in_zero_array(QQSQR ) + call collect_in_zero_array(AV ) + call collect_in_zero_array(AB ) + IF(MYRANK.EQ.0) PRINT*, 'B = ', sum(abs(dble(B))) + IF(MYRANK.EQ.0) PRINT*, 'QQSQR = ', sum(abs(dble(QQSQR))) + IF(MYRANK.EQ.0) PRINT*, 'AV = ', sum(abs(dble(AV))) + IF(MYRANK.EQ.0) PRINT*, 'AB = ', sum(abs(dble(AB))) + endif + + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + AVUI(L,K)=(1.+SUB(L))/(AV(L,K)+SUB(L)*AV(L-1,K)) + AVVI(L,K)=(1.+SVB(L))/(AV(L,K)+SVB(L)*AV(LS,K)) + ENDDO + ENDDO + MPI_WTIMES(806)=MPI_WTIMES(806)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AQ(L,K)=0.205*(AV(L,K-1)+AV(L,K)) + ENDDO + ENDDO + MPI_WTIMES(807)=MPI_WTIMES(807)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AQ(L,1)=0.205*AV(L,1) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AQ(L,KC)=0.205*AV(L,KS) + ENDDO + MPI_WTIMES(808)=MPI_WTIMES(808)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(AQ,ic) + CALL broadcast_boundary_array(AVUI,ic) + CALL broadcast_boundary_array(AVVI,ic) + MPI_WTIMES(810)=MPI_WTIMES(810)+MPI_TOC(S1TIME) + + + if(PRINT_SUM)then + call collect_in_zero_array(AVUI ) + call collect_in_zero_array(AVVI ) + IF(MYRANK.EQ.0) PRINT*, 'avb_AVUI = ', sum(abs(dble(AVUI))) + IF(MYRANK.EQ.0) PRINT*, 'avb_AVVI = ', sum(abs(dble(AVVI))) + endif + + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY_mpi.for new file mode 100644 index 000000000..a045c1629 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBUOY_mpi.for @@ -0,0 +1,202 @@ + SUBROUTINE CALBUOY_mpi +C +C CHANGE RECORD +C ** CALBUOY CALCULATES THE BUOYANCY USING MELLOR'S APPROXIMATION +C ** TO THE UNESCO EQUATION OF STATE (MELLOR, G.L., J. ATM AND OCEAN +C ** TECH, VOL 8, P 609) +C + USE GLOBAL + USE MPI + IMPLICIT NONE + INTEGER::NS,K,L + REAL::RHOO,SSTMP,TTMP,RHTMP,PRES,CCON,TMP,TEM0 +C + IF(IBSC.EQ.1) GOTO 1000 + ISPCOR=0 +C +C ** DENSITY RHOO AT P=0, S=0, AND T=TEMO +C + TEM0 = ABS(TEMO) + RHOO=999.842594+6.793952E-2*TEM0-9.095290E-3*TEM0*TEM0 + & +1.001685E-4*TEM0*TEM0*TEM0-1.120083E-6*TEM0*TEM0*TEM0*TEM0 + & +6.536332E-9*TEM0*TEM0*TEM0*TEM0*TEM0 + + S1TIME=MPI_TIC() + IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).EQ.0)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B(L,K)=RHOO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(821)=MPI_WTIMES(821)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(1).GE.1.AND.ISTRAN(2).EQ.0)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(SSTMP,TEM0) + DO L=LMPI2,LMPILA + SAL(L,K)=MAX(SAL(L,K),0.) + SSTMP=SAL(L,K) + TEM0=ABS(TEMO) + B(L,K)=RHOO+SSTMP*(0.824493-4.0899E-3*TEM0+7.6438E-5*TEM0*TEM0 + & -8.2467E-7*TEM0*TEM0*TEM0+5.3875E-9*TEM0*TEM0*TEM0*TEM0) + & +SQRT(SSTMP)*SSTMP*(-5.72466E-3+1.0227E-4*TEM0 + & -1.6546E-6*TEM0*TEM0)+4.8314E-4*SSTMP*SSTMP + ENDDO + ENDDO + ENDIF + MPI_WTIMES(822)=MPI_WTIMES(822)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU1 = ', sum(abs(dble(B))) + ENDIF + S1TIME=MPI_TIC() + IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).GE.1)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(TTMP) + DO L=LMPI2,LMPILA + TTMP=TEM(L,K) + B(L,K)=999.842594+6.793952E-2*TTMP-9.095290E-3*TTMP*TTMP + & +1.001685E-4*TTMP*TTMP*TTMP-1.120083E-6*TTMP*TTMP* + & TTMP*TTMP+6.536332E-9*TTMP*TTMP*TTMP*TTMP*TTMP + ENDDO + ENDDO + ENDIF + MPI_WTIMES(823)=MPI_WTIMES(823)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU2 = ', sum(abs(dble(B))) + ENDIF + S1TIME=MPI_TIC() + IF(ISTRAN(1).GE.1.AND.ISTRAN(2).GE.1)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(SSTMP,TTMP,RHTMP) + DO L=LMPI2,LMPILA + SAL(L,K)=MAX(SAL(L,K),0.) + SSTMP=SAL(L,K) + TTMP=TEM(L,K) + RHTMP=999.842594+6.793952E-2*TTMP-9.095290E-3*TTMP*TTMP + & +1.001685E-4*TTMP*TTMP*TTMP-1.120083E-6*TTMP*TTMP* + & TTMP*TTMP+6.536332E-9*TTMP*TTMP*TTMP*TTMP*TTMP + B(L,K)=RHTMP+SSTMP*(0.824493-4.0899E-3*TTMP+7.6438E-5* + & TTMP*TTMP-8.2467E-7*TTMP*TTMP*TTMP+5.3875E-9*TTMP*TTMP*TTMP*TTMP) + & +SQRT(SSTMP)*SSTMP*(-5.72466E-3+1.0227E-4*TTMP + & -1.6546E-6*TTMP*TTMP)+4.8314E-4*SSTMP*SSTMP + ENDDO + ENDDO + ENDIF + MPI_WTIMES(824)=MPI_WTIMES(824)+MPI_TOC(S1TIME) +C +C ** APPLY MELLOR'S PRESSURE CORRECTION +C + S1TIME=MPI_TIC() + IF(ISPCOR.EQ.1)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(PRES,CCON,TMP) + DO L=LMPI2,LMPILA + PRES=RHOO*G*HP(L)*(1.-ZZ(K))*1.E-6 + CCON=1449.2+1.34*(SAL(L,K)-35.)+4.55*TEM(L,K) + & -0.045*TEM(L,K)*TEM(L,K)+0.00821*PRES+15.E-9*PRES*PRES + TMP=PRES/(CCON*CCON) + B(L,K)=B(L,K)+1.E+4*TMP*(1.-0.2*TMP) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(825)=MPI_WTIMES(825)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU3 = ', sum(abs(dble(B))) + ENDIF +C +C ** REPLACE DENSITY B(L,K) WITH BUOYANCY B(L,K) +C + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU41 = ', sum(abs(dble(B))),RHOO + ENDIF + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B(L,K)=(B(L,K)/RHOO)-1. + ENDDO + ENDDO + MPI_WTIMES(826)=MPI_WTIMES(826)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU42 = ', sum(abs(dble(B))),RHOO + ENDIF +C +C ** APPLY LOW SEDIMENT CONCENTRATION CORRECTION TO BUOYANCY +C + S1TIME=MPI_TIC() + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1S(L,K)=0. + TVAR1W(L,K)=0. + ENDDO + ENDDO + ENDIF + MPI_WTIMES(827)=MPI_WTIMES(827)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SED(L,K,NS) + TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SED(L,K,NS) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(828)=MPI_WTIMES(828)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(7).GE.1)THEN + DO NN=1,NSND + NS=NN+NSED + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SND(L,K,NN) + TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SND(L,K,NN) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(829)=MPI_WTIMES(829)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B(L,K)=B(L,K)*(1.-TVAR1S(L,K))+TVAR1W(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(830)=MPI_WTIMES(830)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(B) + IF(MYRANK.EQ.0)PRINT*, n,'BU5 = ', sum(abs(dble(B))) + ENDIF + GOTO 2000 +C +C DENSITY AS A LINEAR FUNCTION OF SALINITY ONLY. FOR DIAGNOSTIC +C PURPOSES ONLY +C + 1000 CONTINUE + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B(L,K)=0.00075*SAL(L,K) + ENDDO + ENDDO + MPI_WTIMES(831)=MPI_WTIMES(831)+MPI_TOC(S1TIME) + 2000 CONTINUE + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC_mpi.for new file mode 100644 index 000000000..4fc32fae5 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCONC_mpi.for @@ -0,0 +1,1160 @@ + SUBROUTINE CALCONC_mpi(ISTL_,IS2TL_) +C +C CHANGE RECORD +C MODIFIED CALLS TO CALBAL AND BUDGET SUBROUTINES +C ADDED CALLS TO BAL2T2, BAL2T3 +C ** SUBROUTINE CALCULATES THE CONCENTRATION OF DISSOLVED AND +C ** SUSPENDED CONSTITUTENTS, INCLUDING SALINITY, TEMPERATURE, DYE AND +C ** AND SUSPENDED SEDIMENT AT TIME LEVEL (N+1). THE VALUE OF ISTL +C ** INDICATES THE NUMBER OF TIME LEVELS IN THE STEP +C + USE GLOBAL + USE MPI + + IMPLICIT NONE + INTEGER::K,L,NT,NS,ND,NSID,LDATA,NLC,IWASM,NDAYA,NX + INTEGER::IBALSTDT,NTMP,ISTL_,IS2TL_,M,LF,LL + REAL::TTMP,T1TMP,RCDZKMK,CONASMOLD,SALASM + REAL::TEMASM,DYEASM,SFLASM,RCDZKK,CCUBTMP,CCMBTMP + REAL::DELTD2,CDYETMP,TMP,DAGE + + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EEB + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CCLBTMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::EEB_2D,CCLBTMP_2D + + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TOXASM + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SEDASM + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SNDASM + + IF(.NOT.ALLOCATED(EEB))THEN + ALLOCATE(EEB(LCM)) + ALLOCATE(CCLBTMP(LCM)) + ALLOCATE(EEB_2D(LCM,KCM)) + ALLOCATE(CCLBTMP_2D(LCM,KCM)) + ALLOCATE(TOXASM(NTXM)) + ALLOCATE(SEDASM(NSCM)) + ALLOCATE(SNDASM(NSNM)) + EEB=0.0 + CCLBTMP=0.0 + EEB_2D=0.0 + CCLBTMP_2D=0.0 + TOXASM=0.0 + SEDASM=0.0 + SNDASM=0.0 + ENDIF + + DELT=DT2 + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + END IF + ENDIF + DELTD2=DELT + S1TIME=MPI_TIC() + IF(IS2TIM.GE.1) THEN + IF(ISBAL.GE.1)THEN + CALL BAL2T3A + ENDIF + ENDIF + MPI_WTIMES(601)=MPI_WTIMES(601)+MPI_TOC(S1TIME) +C +C ** VERTICAL DIFFUSION EXPLICIT HALF STEP CALCULATION +C +C 500 CONTINUE +C +C ** 3D ADVECTI0N TRANSPORT CALCULATION-COSMIC INITIALIZATION +C + IF(ISCOSMIC.EQ.1)THEN + S1TIME=MPI_TIC() + DO K=1,KC + RCOSMICX(1 ,K)=0. + RCOSMICX(LC,K)=0. + RCOSMICY(1 ,K)=0. + RCOSMICY(LC,K)=0. + RCOSMICZ(1 ,K)=0. + RCOSMICZ(LC,K)=0. + COSMICXP(1 ,K)=0. + COSMICXP(LC,K)=0. + COSMICYP(1 ,K)=0. + COSMICYP(LC,K)=0. + COSMICZP(1 ,K)=0. + COSMICZP(LC,K)=0. + COSMICXN(1 ,K)=0. + COSMICXN(LC,K)=0. + COSMICYN(1 ,K)=0. + COSMICYN(LC,K)=0. + COSMICZN(1 ,K)=0. + COSMICZN(LC,K)=0. + ENDDO +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + COSMICZP(L,0)=0. + COSMICZP(L,KC)=0. + COSMICZN(L,0)=0. + COSMICZN(L,KC)=0. + ENDDO + MPI_WTIMES(602)=MPI_WTIMES(602)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(TMP) + DO L=LMPI2,LMPILA + RCOSMICX(L,K)=-1. + TMP=U2(L,K)*U2(L+1,K) + IF(TMP.LT.0.) RCOSMICX(L,K)=0. + RCOSMICY(L,K)=-1. + TMP=V2(L,K)*V2(LNC(L),K) + IF(TMP.LT.0.) RCOSMICY(L,K)=0. + RCOSMICZ(L,K)=-1. + TMP=W2(L,K)*W2(L,K-1) + IF(TMP.LT.0.) RCOSMICZ(L,K)=0. + ENDDO + ENDDO + MPI_WTIMES(603)=MPI_WTIMES(603)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICXP(L,K)=DELT*DXIU(L)*U2(L,K) + COSMICYP(L,K)=DELT*DYIV(L)*V2(L,K) + ENDDO + ENDDO + MPI_WTIMES(604)=MPI_WTIMES(604)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICXN(L,K)=MIN(COSMICXP(L,K),0.) + COSMICYN(L,K)=MIN(COSMICYP(L,K),0.) + COSMICXP(L,K)=MAX(COSMICXP(L,K),0.) + COSMICYP(L,K)=MAX(COSMICYP(L,K),0.) + ENDDO + ENDDO + MPI_WTIMES(605)=MPI_WTIMES(605)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(KC.GE.2.AND.ISTL_.EQ.3)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICZP(L,K)=DELT*DZIG(K)*W2(L,K)/H1P(L) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICZN(L,K)=MIN(COSMICZP(L,K),0.) + COSMICZP(L,K)=MAX(COSMICZP(L,K),0.) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(606)=MPI_WTIMES(606)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(KC.GE.2.AND.ISTL_.EQ.2)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICZP(L,K)=2.*DELT*DZIG(K)*W2(L,K)/(HP(L)+H1P(L)) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + COSMICZN(L,K)=MIN(COSMICZP(L,K),0.) + COSMICZP(L,K)=MAX(COSMICZP(L,K),0.) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(607)=MPI_WTIMES(607)+MPI_TOC(S1TIME) + ENDIF +C +C ** 3D ADVECTI0N TRANSPORT CALCULATION +C +C ** PRESPECIFY THE UPWIND CELLS FOR 3D ADVECTION +C + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + IF(UHDY2(L,K).GE.0.0)THEN + LUPU(L,K)=L-1 + ELSE + LUPU(L,K)=L + END IF + IF(VHDX2(L,K).GE.0.0)THEN + LUPV(L,K)=LSC(L) + ELSE + LUPV(L,K)=L + END IF + END IF + ENDDO + ENDDO + MPI_WTIMES(608)=MPI_WTIMES(608)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(KC.GT.1)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + IF(W2(L,K).GE.0.)THEN + KUPW(L,K)=K + ELSE + KUPW(L,K)=K+1 ! *** DSLLC SINGLE LINE CHANGE, CHANGED K-1 TO K+1 + END IF + END IF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(609)=MPI_WTIMES(609)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).LT.4) + & CALL CALTRAN_mpi (ISTL_,IS2TL_,1,1,SAL,SAL1) + MPI_WTIMES(610)=MPI_WTIMES(610)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'3TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + S1TIME=MPI_TIC() + IF(ISTRAN(2).EQ.1.AND.ISCDCA(2).LT.4) + & CALL CALTRAN_mpi (ISTL_,IS2TL_,2,2,TEM,TEM1) + MPI_WTIMES(611)=MPI_WTIMES(611)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'4TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + S1TIME=MPI_TIC() + IF(ISTRAN(3).EQ.1.AND.ISCDCA(3).LT.4) + & CALL CALTRAN_mpi (ISTL_,IS2TL_,3,3,DYE,DYE1) + MPI_WTIMES(612)=MPI_WTIMES(612)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(5).EQ.1.AND.ISCDCA(5).LT.4)THEN + DO NT=1,NTOX + M=MSVTOX(NT) + CALL CALTRAN_mpi (ISTL_,IS2TL_,5,M,TOX(1,1,NT),TOX1(1,1,NT)) + ENDDO + ENDIF + MPI_WTIMES(613)=MPI_WTIMES(613)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + DO NS=1,NSED + call collect_in_zero_array(SED(:,:,NS)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'SED01 = ', sum(abs(dble(SED))) + ENDIF + ENDIF + S1TIME=MPI_TIC() + IF(ISTRAN(6).EQ.1.AND.ISCDCA(6).LT.4)THEN + DO NS=1,NSED + M=MSVSED(NS) + CALL CALTRAN_mpi (ISTL_,IS2TL_,6,M,SED(1,1,NS),SED1(1,1,NS)) + ENDDO + ENDIF + MPI_WTIMES(614)=MPI_WTIMES(614)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + DO NS=1,NSED + call collect_in_zero_array(SED(:,:,NS)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'SED10 = ', sum(abs(dble(SED))) + ENDIF + ENDIF +C + S1TIME=MPI_TIC() + IF(ISTRAN(7).EQ.1.AND.ISCDCA(7).LT.4)THEN + DO NS=1,NSND + M=MSVSND(NS) + CALL CALTRAN_mpi (ISTL_,IS2TL_,6,M,SND(1,1,NS),SND1(1,1,NS)) + ENDDO + ENDIF + MPI_WTIMES(615)=MPI_WTIMES(615)+MPI_TOC(S1TIME) +C +C ** 3D COSMIC ADVECTI0N TRANSPORT CALCULATION +C + IF(ISCOSMIC.EQ.1)THEN + CALL CPU_TIME(TTMP) + S1TIME=MPI_TIC() + IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).EQ.4) + & CALL COSTRANW (ISTL,IS2TL,1,1,SAL,SAL1) + MPI_WTIMES(616)=MPI_WTIMES(616)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(2).EQ.1.AND.ISCDCA(2).EQ.4) + & CALL COSTRANW (ISTL,IS2TL,2,2,TEM,TEM1) + MPI_WTIMES(617)=MPI_WTIMES(617)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(3).EQ.1.AND.ISCDCA(3).EQ.4) + & CALL COSTRANW (ISTL,IS2TL,3,3,DYE,DYE1) + MPI_WTIMES(618)=MPI_WTIMES(618)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(1).EQ.1.AND.ISCDCA(1).EQ.5) + & CALL COSTRAN (ISTL,IS2TL,1,1,SAL,SAL1) + MPI_WTIMES(619)=MPI_WTIMES(619)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(2).EQ.1.AND.ISCDCA(2).EQ.5) + & CALL COSTRAN (ISTL,IS2TL,2,2,TEM,TEM1) + MPI_WTIMES(620)=MPI_WTIMES(620)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(3).EQ.1.AND.ISCDCA(3).EQ.5) + & CALL COSTRAN (ISTL,IS2TL,3,3,DYE,DYE1) + MPI_WTIMES(621)=MPI_WTIMES(621)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(5).EQ.1.AND.ISCDCA(5).EQ.4)THEN + DO NT=1,NTOX + M=MSVTOX(NT) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=TOX1(L,K,NT) + TVAR2S(L,K)=TOX(L,K,NT) + ENDDO + ENDDO + CALL COSTRANW (ISTL,IS2TL,5,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TOX1(L,K,NT)=TVAR1S(L,K) + TOX(L,K,NT)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(622)=MPI_WTIMES(622)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(5).EQ.1.AND.ISCDCA(5).EQ.5)THEN + DO NT=1,NTOX + M=MSVTOX(NT) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=TOX1(L,K,NT) + TVAR2S(L,K)=TOX(L,K,NT) + ENDDO + ENDDO + CALL COSTRAN (ISTL,IS2TL,5,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TOX1(L,K,NT)=TVAR1S(L,K) + TOX(L,K,NT)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(623)=MPI_WTIMES(623)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(6).EQ.1.AND.ISCDCA(6).EQ.4)THEN + DO NS=1,NSED + M=MSVSED(NS) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=SED1(L,K,NS) + TVAR2S(L,K)=SED(L,K,NS) + ENDDO + ENDDO + CALL COSTRANW (ISTL,IS2TL,6,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SED1(L,K,NS)=TVAR1S(L,K) + SED(L,K,NS)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(624)=MPI_WTIMES(624)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(6).EQ.1.AND.ISCDCA(6).EQ.5)THEN + DO NS=1,NSED + M=MSVSED(NS) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=SED1(L,K,NS) + TVAR2S(L,K)=SED(L,K,NS) + ENDDO + ENDDO + CALL COSTRAN (ISTL,IS2TL,6,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SED1(L,K,NS)=TVAR1S(L,K) + SED(L,K,NS)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(625)=MPI_WTIMES(625)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(7).EQ.1.AND.ISCDCA(7).EQ.4)THEN + DO NS=1,NSND + M=MSVSND(NS) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=SND1(L,K,NS) + TVAR2S(L,K)=SND(L,K,NS) + ENDDO + ENDDO + CALL COSTRANW (ISTL,IS2TL,7,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SND1(L,K,NS)=TVAR1S(L,K) + SND(L,K,NS)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(626)=MPI_WTIMES(626)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(7).EQ.1.AND.ISCDCA(7).EQ.5)THEN + DO NS=1,NSND + M=MSVSND(NS) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=SND1(L,K,NS) + TVAR2S(L,K)=SND(L,K,NS) + ENDDO + ENDDO + CALL COSTRAN (ISTL,IS2TL,7,M,TVAR2S,TVAR1S) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SND1(L,K,NS)=TVAR1S(L,K) + SND(L,K,NS)=TVAR2S(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + CALL CPU_TIME(T1TMP) + TSADV=TSADV+T1TMP-TTMP + ENDIF + MPI_WTIMES(627)=MPI_WTIMES(627)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'5TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +C +C ** 1D ADVECTI0N TRANSPORT CALCULATION +C +C *** REMOVED 2004-09-19 PMC +C +C ** SURFACE AND INTERNAL HEAT SOURCE-SINK CALCULATION +C + S1TIME=MPI_TIC() + IF(ISTRAN(2).GE.1) CALL CALHEAT_mpi(ISTL_) + MPI_WTIMES(628)=MPI_WTIMES(628)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'6TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +C +C ** FULL IMPLICIT DYE AND TOXIC CONTAMINANT DECAY/GROWTH CALCULATION +C + S1TIME=MPI_TIC() + IF(ISTRAN(3).GE.1)THEN + ! *** DSLLC BEGIN BLOCK + IF(RKDYE.EQ.1000.0)THEN + ! *** Age of Water + DAGE=DELT/86400. + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DYE(L,K)=DYE(L,K)+DAGE + ENDDO + ENDDO + ELSE + IF(RKDYE.LT.0.0)THEN + CDYETMP=EXP(-RKDYE*DELT) + ELSE + CDYETMP=1./(1.+DELT*RKDYE) + ENDIF + + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO K=1,KC + DO L=LF,LL + DYE(L,K)=CDYETMP*DYE(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + ! *** DSLLC END BLOCK + ENDIF + MPI_WTIMES(629)=MPI_WTIMES(629)+MPI_TOC(S1TIME) +C +C ** BOTTOM AND INTERNAL SEDIMENT AND TOXIC CONTAMINAT +C ** SOURCE-SINK CALCULATION +C +C +C ** SEDIMENT AND TOXICS SETTLING,DEPOSITION,RESUSPENSION,ETC +C ** FOR TWO TIME LEVEL SIMULATION +C + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1) THEN + IF(IS2TIM.GE.1)THEN + ISEDDTC=ISEDDTC+1 + IF(ISEDDTC.EQ.1)THEN + DTSED=DELT + ELSE + DTSED=DTSED+DELT + ENDIF + IBALSTDT=0 + S1TIME=MPI_TIC() + IF(ISEDDTC.EQ.ISEDDT)THEN + CALL SSEDTOX(ISTL,IS2TL,1.0) + IBALSTDT=1 + ISEDDTC=0 + ENDIF + MPI_WTIMES(630)=MPI_WTIMES(630)+MPI_TOC(S1TIME) +C +C ** SEDIMENT AND TOXICS SETTLING,DEPOSITION,RESUSPENSION,ETC +C ** FOR THREE TIME LEVEL SIMULATION +C + ELSE ! IF(IS2TIM.EQ.0)THEN + S1TIME=MPI_TIC() + IBALSTDT=0 + DTSED=FLOAT(NTSTBC)*DT + CALL SSEDTOX(ISTL,IS2TL,1.0) + IBALSTDT=1 + MPI_WTIMES(631)=MPI_WTIMES(631)+MPI_TOC(S1TIME) + ENDIF + ENDIF +C +C 888 FORMAT('N,IC,I,DTS,DT = ',3I5,2F12.8) +C 889 FORMAT('N,IC,I,DTS = ',3I5,F12.8,12X,'SSEDTOX CALLED') + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'7TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +C +C ** OPTIONAL MASS BALANCE CALCULATION +C + IF(IS2TIM.EQ.0) THEN + IF(ISTL_.NE.2.AND.ISBAL.GE.1)THEN + S1TIME=MPI_TIC() + CALL CALBAL2 + CALL CALBAL3 + MPI_WTIMES(632)=MPI_WTIMES(632)+MPI_TOC(S1TIME) + NTMP=MOD(N,2) + IF(NTMP.EQ.0)THEN + S1TIME=MPI_TIC() + CALL CBALEV2 + CALL CBALEV3 + MPI_WTIMES(633)=MPI_WTIMES(633)+MPI_TOC(S1TIME) + ELSE + S1TIME=MPI_TIC() + CALL CBALOD2 + CALL CBALOD3 + MPI_WTIMES(634)=MPI_WTIMES(634)+MPI_TOC(S1TIME) + ENDIF + ENDIF + ENDIF +C +C ** CALLS TO TWO-TIME LEVEL BALANCES +C + IF(IS2TIM.GE.1) THEN + IF(ISBAL.GE.1)THEN + S1TIME=MPI_TIC() + CALL BAL2T2 + CALL BAL2T3B(IBALSTDT) + MPI_WTIMES(635)=MPI_WTIMES(635)+MPI_TOC(S1TIME) + ENDIF + ENDIF +C +C ** SEDIMENT BUDGET CALCULATION (DLK 10/15) +C + IF(IS2TIM.EQ.0) THEN + IF(ISTL_.NE.2.AND.ISSBAL.GE.1)THEN + S1TIME=MPI_TIC() + CALL BUDGET2 + CALL BUDGET3 + MPI_WTIMES(636)=MPI_WTIMES(636)+MPI_TOC(S1TIME) + ENDIF + ENDIF + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'8TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +C +C ** VERTICAL DIFFUSION IMPLICIT HALF STEP CALCULATION +C + IF(KC.EQ.1) GOTO 1500 + CALL CPU_TIME(TTMP) + RCDZKK=-DELTD2*CDZKK(1) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP) + DO L=LMPI2,LMPILA + CCUBTMP=RCDZKK*HPI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB(L)=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB(L) + ENDDO + IF(ISTRAN(1).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SAL(L,1)=SAL(L,1)*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(2).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,1)=TEM(L,1)*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(3).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DYE(L,1)=DYE(L,1)*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TOX(L,1,NT)=TOX(L,1,NT)*EEB(L) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SED(L,1,NS)=SED(L,1,NS)*EEB(L) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NS=1,NSND +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SND(L,1,NS)=SND(L,1,NS)*EEB(L) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(637)=MPI_WTIMES(637)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + + DO K=2,KS + RCDZKMK=-DELTD2*CDZKMK(K) + RCDZKK=-DELTD2*CDZKK(K) +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP) + DO L=LMPI2,LMPILA + CCLBTMP_2D(L,K)=RCDZKMK*HPI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HPI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP_2D(L,K)-CCUBTMP + EEB_2D(L,K)=1./(CCMBTMP-CCLBTMP_2D(L,K)*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB_2D(L,K) + ENDDO + ENDDO + + IF(ISTRAN(1).GE.1)THEN + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SAL(L,K)=(SAL(L,K)-CCLBTMP_2D(L,K)*SAL(L,K-1))*EEB_2D(L,K) + ENDDO + ENDDO + ENDIF + + IF(ISTRAN(2).GE.1)THEN + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,K)=(TEM(L,K)-CCLBTMP_2D(L,K)*TEM(L,K-1))*EEB_2D(L,K) + ENDDO + ENDDO + ENDIF + + IF(ISTRAN(3).GE.1)THEN + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DYE(L,K)=(DYE(L,K)-CCLBTMP_2D(L,K)*DYE(L,K-1))*EEB_2D(L,K) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TOX(L,K,NT)=(TOX(L,K,NT)-CCLBTMP_2D(L,K)*TOX(L,K-1,NT)) + & *EEB_2D(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SED(L,K,NS)=(SED(L,K,NS)-CCLBTMP_2D(L,K)*SED(L,K-1,NS)) + & *EEB_2D(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NS=1,NSND + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SND(L,K,NS)=(SND(L,K,NS)-CCLBTMP_2D(L,K)*SND(L,K-1,NS)) + & *EEB_2D(L,K) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(638)=MPI_WTIMES(638)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'9TEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + K=KC + RCDZKMK=-DELTD2*CDZKMK(K) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(CCMBTMP) + DO L=LMPI2,LMPILA + CCLBTMP(L)=RCDZKMK*HPI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP(L) + EEB(L)=1./(CCMBTMP-CCLBTMP(L)*CU1(L,K-1)) + ENDDO + IF(ISTRAN(1).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SAL(L,K)=(SAL(L,K)-CCLBTMP(L)*SAL(L,K-1))*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(2).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,K)=(TEM(L,K)-CCLBTMP(L)*TEM(L,K-1))*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(3).GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DYE(L,K)=(DYE(L,K)-CCLBTMP(L)*DYE(L,K-1))*EEB(L) + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TOX(L,K,NT)=(TOX(L,K,NT)-CCLBTMP(L)*TOX(L,K-1,NT))*EEB(L) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SED(L,K,NS)=(SED(L,K,NS)-CCLBTMP(L)*SED(L,K-1,NS))*EEB(L) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NS=1,NSND +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SND(L,K,NS)=(SND(L,K,NS)-CCLBTMP(L)*SND(L,K-1,NS))*EEB(L) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(639)=MPI_WTIMES(639)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISTRAN(1).GE.1)THEN + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SAL(L,K)=SAL(L,K)-CU1(L,K)*SAL(L,K+1) + ENDDO + ENDDO + ENDIF + + IF(ISTRAN(2).GE.1)THEN + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,K)=TEM(L,K)-CU1(L,K)*TEM(L,K+1) + ENDDO + ENDDO + ENDIF + + IF(ISTRAN(3).GE.1)THEN + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DYE(L,K)=DYE(L,K)-CU1(L,K)*DYE(L,K+1) + ENDDO + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TOX(L,K,NT)=TOX(L,K,NT)-CU1(L,K)*TOX(L,K+1,NT) + ENDDO + ENDDO + ENDDO + ENDIF + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SED(L,K,NS)=SED(L,K,NS)-CU1(L,K)*SED(L,K+1,NS) + ENDDO + ENDDO + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NS=1,NSND + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SND(L,K,NS)=SND(L,K,NS)-CU1(L,K)*SND(L,K+1,NS) + ENDDO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(640)=MPI_WTIMES(640)+MPI_TOC(S1TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'ATEM = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + S1TIME=MPI_TIC() +C DO K=1,KB +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDBT(L,1:KB)=0. + SNDBT(L,1:KB)=0. + ENDDO +C ENDDO +C DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDT(L,1:KC)=0. + SNDT(L,1:KC)=0. + ENDDO +C ENDDO + DO K=1,KB + DO NS=1,NSED +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDBT(L,K)=SEDBT(L,K)+SEDB(L,K,NS) + ENDDO + ENDDO + ENDDO + DO NS=1,NSND + DO K=1,KB +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SNDBT(L,K)=SNDBT(L,K)+SNDB(L,K,NS) + ENDDO + ENDDO + ENDDO + DO NS=1,NSED + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDT(L,K)=SEDT(L,K)+SED(L,K,NS) + ENDDO + ENDDO + ENDDO + DO NS=1,NSND + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SNDT(L,K)=SNDT(L,K)+SND(L,K,NS) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(641)=MPI_WTIMES(641)+MPI_TOC(S1TIME) + CALL CPU_TIME(T1TMP) + TVDIF=TVDIF+T1TMP-TTMP + 1500 CONTINUE +C +C ** DATA ASSIMILATION +C + S1TIME=MPI_TIC() + IF(NLCDA.GT.0)THEN + SALASM=0.0 + TEMASM=0.0 + DYEASM=0.0 + SFLASM=0.0 + DO NT=1,NTOX + TOXASM(NT)=0.0 + ENDDO + DO NS=1,NSED + SEDASM(NS)=0.0 + ENDDO + DO NS=1,NSND + SNDASM(NS)=0.0 + ENDDO +C + IWASM=0 +C + IF(N.EQ.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CDATASM.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CDATASM.DIA') + IWASM=1 + DO NLC=1,NLCDA + DO NDAYA=1,NTC + FSALASM(NDAYA,NLC)=0. + FVOLASM(NDAYA,NLC)=0. + FTEMASM(NDAYA,NLC)=0. + ENDDO + ENDDO + ENDIF +C + NDAYA=MOD(N,NTSPTC) + NDAYA=1+(N-NDAYA)/NTSPTC +C + IF(N.EQ.NTSPTC.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CDATASM.DIA',POSITION='APPEND') + IWASM=1 + WRITE(1,1212)N,NDAYA + ENDIF +C + IF(ISCDA(1).GT.0)THEN + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=SAL(L,K) + NSID=NCSERA(NLC,1) + IF(IWASM.EQ.1) WRITE(1,1111)N,NLC,ICDA(NLC),JCDA(NLC),NS, + & CSERT(K,NS,1),SAL(L,K) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,1).GT.0)THEN + FSALASM(NDAYA,NLC)=FSALASM(NDAYA,NLC)+TSCDA*DZC(K)* + & DXYP(L)*HP(L)*(CSERT(K,NSID,1)-SAL(L,K)) + FVOLASM(NDAYA,NLC)=FVOLASM(NDAYA,NLC)+TSCDA*DZC(K)* + & DXYP(L)*HP(L)*(1.0-( CSERT(K,NSID,1)/SAL(L,K) )) + SAL(L,K)=TSCDA*CSERT(K,NSID,1)+(1.-TSCDA)*SAL(L,K) + ENDIF + ENDIF + ENDIF + IF(IWASM.EQ.1) WRITE(1,1111)N,NLC,ICDA(NLC),JCDA(NLC),NS, + & CSERT(K,NS,1),SAL(L,K) + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + SAL(L,K)=TSCDA*SAL(LDATA,K)+(1.-TSCDA)*SAL(L,K) + ENDIF + SALASM=SALASM+HP(L)*DXYP(L)*(SAL(L,K)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDIF +C + IF(ISCDA(2).GT.0)THEN + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=TEM(L,K) + NSID=NCSERA(NLC,2) + IF(IWASM.EQ.1) WRITE(1,1112)N,NLC,ICDA(NLC),JCDA(NLC),NS, + & CSERT(K,NS,2),TEM(L,K) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,2).GT.0)THEN + FTEMASM(NDAYA,NLC)=FTEMASM(NDAYA,NLC)+TSCDA*DZC(K)* + & DXYP(L)*HP(L)*(CSERT(K,NSID,2)-TEM(L,K)) + TEM(L,K)=TSCDA*CSERT(K,NSID,2)+(1.-TSCDA)*TEM(L,K) + ENDIF + ENDIF + ENDIF + IF(IWASM.EQ.1) WRITE(1,1112)N,NLC,ICDA(NLC),JCDA(NLC),NS, + & CSERT(K,NSID,2),TEM(L,K) + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + TEM(L,K)=TSCDA*TEM(LDATA,K)+(1.-TSCDA)*TEM(L,K) + ENDIF + TEMASM=TEMASM+HP(L)*DXYP(L)*(TEM(L,K)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDIF +C + IF(ISCDA(3).GT.0)THEN + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=DYE(L,K) + NSID=NCSERA(NLC,3) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NS.GT.0)THEN + IF(CSERT(K,NSID,3).GT.0)THEN + DYE(L,K)=TSCDA*CSERT(K,NSID,3)+(1.-TSCDA)*DYE(L,K) + ENDIF + ENDIF + ENDIF + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + DYE(L,K)=TSCDA*DYE(LDATA,K)+(1.-TSCDA)*DYE(L,K) + ENDIF + DYEASM=DYEASM+HP(L)*DXYP(L)*(DYE(L,K)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDIF +C + IF(ISCDA(4).GT.0)THEN + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=SFL(L,K) + NSID=NCSERA(NLC,4) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,4).GT.0)THEN + SFL(L,K)=TSCDA*CSERT(K,NSID,4)+(1.-TSCDA)*SFL(L,K) + ENDIF + ENDIF + ENDIF + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + SFL(L,K)=TSCDA*SFL(LDATA,K)+(1.-TSCDA)*SFL(L,K) + ENDIF + SFLASM=SFLASM+HP(L)*DXYP(L)*(SFL(L,K)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDIF +C + IF(ISCDA(5).GT.0)THEN + DO NT=1,NTOX + M=MSVTOX(NT) + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=TOX(L,K,NT) + NSID=NCSERA(NLC,M) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,M).GT.0)THEN + TOX(L,K,NT)=TSCDA*CSERT(K,NSID,M)+(1.-TSCDA)* + & TOX(L,K,NT) + ENDIF + ENDIF + ENDIF + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + TOX(L,K,NT)=TSCDA*TOX(LDATA,K,NT)+(1.-TSCDA)*TOX(L,K,NT) + ENDIF + TOXASM(NT)=TOXASM(NT) + & +HP(L)*DXYP(L)*(TOX(L,K,NT)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDDO + ENDIF +C + IF(ISCDA(6).GT.0)THEN + DO NS=1,NSED + M=MSVSED(NS) + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=SED(L,K,NS) + NSID=NCSERA(NLC,M) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,M).GT.0)THEN + SED(L,K,NS)=TSCDA*CSERT(K,NSID,M)+(1.-TSCDA)* + & SED(L,K,NS) + ENDIF + ENDIF + ENDIF + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + SED(L,K,NS)=TSCDA*SED(LDATA,K,NS)+(1.-TSCDA)*SED(L,K,NS) + ENDIF + SEDASM(NS)=SEDASM(NS) + & +HP(L)*DXYP(L)*(SED(L,K,NS)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDDO + ENDIF +C +C6222 FORMAT(' TC,SNEW,SASSM,SOLD='4F10.2) +C + IF(ISCDA(7).GT.0)THEN + DO NX=1,NSND + M=MSVSND(NX) + DO K=1,KC + DO NLC=1,NLCDA + L=LIJ(ICDA(NLC),JCDA(NLC)) + CONASMOLD=SND(L,K,NX) + NSID=NCSERA(NLC,M) + IF(ITPCDA(NLC).EQ.0)THEN + IF(NSID.GT.0)THEN + IF(CSERT(K,NSID,M).GT.0)THEN + SND(L,K,NX)=TSCDA*CSERT(K,NSID,M)+(1.-TSCDA)* + & SND(L,K,NX) + ENDIF + ENDIF + ENDIF + IF(ITPCDA(NLC).EQ.1)THEN + LDATA=LIJ(ICCDA(NLC),JCCDA(NLC)) + SND(L,K,NX)=TSCDA*SND(LDATA,K,NX)+(1.-TSCDA)*SND(L,K,NX) + ENDIF + SNDASM(NX)=SNDASM(NX) + & +HP(L)*DXYP(L)*(SND(L,K,NX)-CONASMOLD)*DZC(K) + ENDDO + ENDDO + ENDDO + ENDIF +C + IF(IWASM.EQ.1.AND.MYRANK.EQ.0)THEN + CLOSE(1) + ENDIF +C + IF(IS2TIM.GE.1) THEN + IF(ISBAL.GE.1)THEN + SALOUT=SALOUT-SALASM + DYEOUT=DYEOUT-DYEASM + DO NT=1,NTOX + TOXOUT2T(NT)=TOXOUT2T(NT)-TOXASM(NT) + ENDDO + DO NS=1,NSED + SEDOUT2T(NS)=SEDOUT2T(NS)-SEDASM(NS) + ENDDO + DO NS=1,NSND + SNDOUT2T(NS)=SNDOUT2T(NS)-SNDASM(NS) + ENDDO + ENDIF + ENDIF +C + ENDIF + MPI_WTIMES(642)=MPI_WTIMES(642)+MPI_TOC(S1TIME) +C + 1111 FORMAT(' SAL '5I5,2F10.3) + 1112 FORMAT(' TEM '5I5,2F10.3) + 1212 FORMAT(' N,NDAYA = ',2I12) +C +C ** SURFACE AND INTERNAL HEAT SOURCE-SINK CALCULATION +C ** DYE DECAY CALCULATION +C ** BOTTOM AND INTERNAL SEDIMENT SOURCE-SINK CALCULATION +C + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER_mpi.for new file mode 100644 index 000000000..4518cc970 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALCSER_mpi.for @@ -0,0 +1,358 @@ + SUBROUTINE CALCSER_mpi(ISTL_) +C +C CHANGE RECORD +C ** SUBROUTINE CALPSER UPDATES TIME VARIABLE SALINITY, TEMPERATURE +C ** DYE, SEDIMENT, AND SHELL FISH LARVAE +C ** BOUNDARY CONDITIONS AND INFLOW CONCENTRATIONS +C + USE GLOBAL + USE MPI + + IMPLICIT NONE + INTEGER::NS,K,NT,NTT,ISTL_,M1,M2,NQ + REAL::TIME,TDIFF,WTM1,WTM2 +C +C ** INITIALIZE NULL SERIES CONCENTRATIONS +C + S1TIME=MPI_TIC() + NTT=4+NTOX+NSED+NSND + DO NT=1,NTT + CQWRSERT(0,NT)=0. + DO K=1,KC + CSERT(K,0,NT)=0. + ENDDO + ENDDO + MPI_WTIMES(451)=MPI_WTIMES(451)+MPI_TOC(S1TIME) +C +C ** CONCENTRATION SERIES INTERPOLTATION, SAL,TEM,DYE,SFL +C + CSERT_TMP=0. + S1TIME=MPI_TIC() + DO NC=1,4 + IF(ISTRAN(NC).EQ.0) GOTO 200 +!!$OMP PARALLEL DO PRIVATE(TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NS=1,NCSER(NC) + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N-1)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 100 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 100 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + 200 CONTINUE + ENDDO + MPI_WTIMES(452)=MPI_WTIMES(452)+MPI_TOC(S1TIME) +C +C ** CONCENTRATION SERIES INTERPOLTATION FOR TOX +C + S1TIME=MPI_TIC() + IF(ISTRAN(5).GE.1)THEN +!!$OMP PARALLEL DO PRIVATE(NC,TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NT=1,NTOX + NC=MSVTOX(NT) + DO NS=1,NCSER(NC) + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N-1)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 101 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 101 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(453)=MPI_WTIMES(453)+MPI_TOC(S1TIME) +C +C ** CONCENTRATION SERIES INTERPOLTATION FOR SED +C + S1TIME=MPI_TIC() + IF(ISTRAN(6).GE.1)THEN +!!$OMP PARALLEL DO PRIVATE(NC,TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NT=1,NSED + NC=MSVSED(NT) + DO NS=1,NCSER(NC) + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N-1))/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 102 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 102 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(454)=MPI_WTIMES(454)+MPI_TOC(S1TIME) + +C ** CONCENTRATION SERIES INTERPOLTATION FOR SND +C + S1TIME=MPI_TIC() + IF(ISTRAN(7).GE.1)THEN +!!$OMP PARALLEL DO PRIVATE(NC,TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NT=1,NSND + NC=MSVSND(NT) + DO NS=1,NCSER(NC) + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N-1))/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 103 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 103 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(455)=MPI_WTIMES(455)+MPI_TOC(S1TIME) +C +C ** CONCENTRATION SERIES INTERPOLTATION FOR WATER QUALITY +C + IF(ISTRAN(8).GE.1)THEN ! .AND.IWQPSL.EQ.2)THEN + S1TIME=MPI_TIC() +!!$OMP PARALLEL DO PRIVATE(NC,TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NQ=1,NWQV + NC=4+NTOX+NSED+NSND+NQ + DO NS=1,NCSER(NC) +C IF(IS_QSER(NS))THEN + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N-1))/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 104 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 104 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + ENDDO + MPI_WTIMES(456)=MPI_WTIMES(456)+MPI_TOC(S1TIME) +!{ GEOSR x-species. jgcho 2015.11.04 + S1TIME=MPI_TIC() +!!$OMP PARALLEL DO PRIVATE(NC,TIME,M1,M2,TDIFF,WTM1,WTM2) + DO NQ=1,NXSP + NC=4+NTOX+NSED+NSND+NWQV+NQ + DO NS=1,NCSER(NC) +C IF(IS_QSER(NS))THEN + IF(IS_CSER(NS,NC))THEN + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N-1))/TCCSER(NS,NC) + & +TBEGIN*(TCON/TCCSER(NS,NC)) + ELSE + TIME=TIMESEC/TCCSER(NS,NC) + ENDIF + ENDIF + M1=MCTLAST(NS,NC) + 105 CONTINUE + M2=M1+1 + IF(TIME.GT.TCSER(M2,NS,NC))THEN + M1=M2 + GOTO 105 + ELSE + MCTLAST(NS,NC)=M1 + ENDIF + TDIFF=TCSER(M2,NS,NC)-TCSER(M1,NS,NC) + WTM1=(TCSER(M2,NS,NC)-TIME)/TDIFF + WTM2=(TIME-TCSER(M1,NS,NC))/TDIFF +C DO K=1,KC + CSERT(:,NS,NC)=WTM1*CSER(M1,:,NS,NC)+WTM2*CSER(M2,:,NS,NC) +C ENDDO + ENDIF + ENDDO + ENDDO + MPI_WTIMES(457)=MPI_WTIMES(457)+MPI_TOC(S1TIME) +!} GEOSR x-species. jgcho 2015.11.04 + ENDIF +C +C ** WRITE DIAGNOSTIC FILE FOR CSER INTERPOLTATION +C + S1TIME=MPI_TIC() + IF(ISDIQ.GE.1.AND.N.EQ.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CDIAG.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CDIAG.OUT',STATUS='UNKNOWN') + DO NC=1,NTT + WRITE(1,1001)NC + DO NS=1,NCSER(NC) + WRITE(1,1002)NS,(CSERT(K,NS,NC),K=1,KC) + ENDDO + ENDDO + CLOSE(1) + ENDIF + MPI_WTIMES(458)=MPI_WTIMES(458)+MPI_TOC(S1TIME) + 1001 FORMAT(/' TRANSPORT VARIABLE ID =',I5/) + 1002 FORMAT(I5,2X,12E12.4) +C +C ** SHELL FISH LARVAE BEHAVIOR TIME SERIES INTERPOLTATION +C + S1TIME=MPI_TIC() + IF(ISTRAN(4).EQ.0) GOTO 400 + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*(FLOAT(N)-0.5)/TCSFSER + & +TBEGIN*(TCON/TCSFSER) + ELSE + TIME=TIMESEC/TCSFSER + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N-1)/TCSFSER + & +TBEGIN*(TCON/TCSFSER) + ELSE + TIME=TIMESEC/TCSFSER + ENDIF + ENDIF + M1=MSFTLST + 300 CONTINUE + M2=M1+1 + IF(TIME.GT.TSFSER(M2))THEN + M1=M2 + GOTO 300 + ELSE + MSFTLST=M1 + ENDIF + TDIFF=TSFSER(M2)-TSFSER(M1) + WTM1=(TSFSER(M2)-TIME)/TDIFF + WTM2=(TIME-TSFSER(M1))/TDIFF + RKDSFLT=WTM1*RKDSFL(M1)+WTM2*RKDSFL(M2) + WSFLSTT=WTM1*WSFLST(M1)+WTM2*WSFLST(M2) + WSFLSMT=WTM1*WSFLSM(M1)+WTM2*WSFLSM(M2) + DSFLMNT=WTM1*DSFLMN(M1)+WTM2*DSFLMN(M2) + DSFLMXT=WTM1*DSFLMX(M1)+WTM2*DSFLMX(M2) + SFNTBET=WTM1*SFNTBE(M1)+WTM2*SFNTBE(M2) + SFATBTT=WTM1*SFATBT(M1)+WTM2*SFATBT(M2) + 400 CONTINUE + MPI_WTIMES(459)=MPI_WTIMES(459)+MPI_TOC(S1TIME) +C6000 FORMAT('N, CSERT(1),CSERT(KC) = ',I6,4X,2F12.2) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDIFF_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDIFF_mpi.for new file mode 100644 index 000000000..93a913069 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDIFF_mpi.for @@ -0,0 +1,30 @@ + SUBROUTINE CALDIFF_mpi (ISTL_,M,CON1) +C +C CHANGE RECORD +C ** SUBROUTINE CALDIFF CALCULATES THE HORIZONTAL DIFFUSIVE +C ** TRANSPORT OF DISSOLVED OR SUSPENDED CONSITITUENT M LEADING TO +C ** A REVISEDED VALUE AT TIME LEVEL (N+1). THE VALUE OF ISTL +C ** INDICATES THE NUMBER OF TIME LEVELS IN THE STEP +C + USE GLOBAL + USE MPI + IMPLICIT NONE + INTEGER::K,L,LS,M,ISTL_ + REAL::CON1 + DIMENSION CON1(LCM,KCM) +C +C ** HORIZONTAL DIFFUSIVE FLUX CALCULATION +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FUHU(L,K)=FUHU(L,K)+0.5*SUB(L)*DYU(L)*HU(L)*(AH(L,K)+AH(L-1,K))* + & (CON1(L-1,K)-CON1(L,K))*DXIU(L) + FVHU(L,K)=FVHU(L,K)+0.5*SVB(L)*DXV(L)*HV(L)*(AH(L,K)+AH(LS,K))* + & (CON1(LS,K)-CON1(L,K))*DYIV(L) + ENDDO + ENDDO + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI_mpi.for new file mode 100644 index 000000000..0900366d2 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEBI_mpi.for @@ -0,0 +1,97 @@ + SUBROUTINE CALEBI_mpi +C +C CHANGE RECORD +C ** CALEBI CALCULATES THE EXTERNAL BUOYANCY INTEGRALS +C + USE GLOBAL + USE MPI + IMPLICIT NONE + INTEGER::K,L,LLCM + REAL::DBK,DZCBK + + REAL*4 DZCB(KCM) + REAL*4 BK(KCM) + + PARAMETER(LLCM=200) + + IF(.FALSE.)THEN + S2TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(DBK,DZCBK) + DO L=LMPI2,LMPILA + + BI1(L)=0. + BI2(L)=0. + BE(L)=0. + + DO K=1,KC + DZCB(K)=DZC(K)*B(L,K) + ENDDO + + DBK=0. + DO K=KC,1,-1 + DBK=DBK+DZCB(K) !DZC(K)*B(L,K) + BK(K)=DBK-0.5*DZCB(K) !DZC(K)*B(L,K) + ENDDO + + !Z(0)=0. + !Z(K)=Z(K-1)+DZC(K) + DO K=1,KC + BE(L) =BE(L)+DZCB(K) !DZC(K)*B(L,K) + DZCBK =DZC(K)*BK(K) + BI1(L)=BI1(L)+DZCBK + BI2(L)=BI2(L)+(DZCBK+0.5*(Z(K)+Z(K-1))*DZCB(K)) + ENDDO + + ENDDO + MPI_WTIMES(251)=MPI_WTIMES(251)+MPI_TOC(S2TIME) + + ELSE + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + BI1(L)=0. + BI2(L)=0. + BE(L)=0. + ENDDO + MPI_WTIMES(251)=MPI_WTIMES(251)+MPI_TOC(S2TIME) + + S2TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DZCB_2D(L,K)=DZC(K)*B(L,K) + ENDDO + ENDDO + MPI_WTIMES(252)=MPI_WTIMES(252)+MPI_TOC(S2TIME) + + S2TIME=MPI_TIC() + DBK_1D=0. + DO K=KC,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DBK_1D(L)=DBK_1D(L)+DZCB_2D(L,K) + BK_2D(L,K)=DBK_1D(L)-0.5*DZCB_2D(L,K) + ENDDO + ENDDO + MPI_WTIMES(253)=MPI_WTIMES(253)+MPI_TOC(S2TIME) + + S2TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + BE(L) =BE(L)+DZCB_2D(L,K) + BI1(L)=BI1(L)+DZC(K)*BK_2D(L,K) + BI2(L)=BI2(L)+(DZC(K)*BK_2D(L,K)+ + & 0.5*(Z(K)+Z(K-1))*DZCB_2D(L,K)) + ENDDO + ENDDO + MPI_WTIMES(254)=MPI_WTIMES(254)+MPI_TOC(S2TIME) + ENDIF + + CALL broadcast_boundary(BE,ic) + CALL broadcast_boundary(BI1,ic) + CALL broadcast_boundary(BI2,ic) + + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T_mpi.for new file mode 100644 index 000000000..e4cdd4951 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T_mpi.for @@ -0,0 +1,1338 @@ + SUBROUTINE CALEXP2T_mpi +C +C ** SUBROUTINE CALEXP2T CALCULATES EXPLICIT MOMENTUM EQUATION TERMS +C ** USING A TWO TIME LEVEL SCHEME +C CHANGE RECORD +C ADDED BODY FORCES FBODYFX AND FBODYFY TO EXTERNAL MOMENTUM EQUATIONS +C CORRECTED ORIENTATION OF MOMENTUM FLUXES FROM SINKS AND SOURCE +C CORRECTED 2 LAYER (KC=-2) CURVATURE ACCELERATION CORRECTION +C ADDED ICK2COR,CK2UUM,CK2VVM,CK2UVM,CK2UUC,CK2VVC,CK2UVC,CK2FCX, +C CK2FCY TO GENERALIZE TWO LAYER MOMENTUM FLUX AND CURVATURE +C ACCELERATION CORRECTION +C MODIFIED CALCULATION OF CORIOLIS-CURVATURE ACCELERATIONS AT TIDAL +C OPEN BOUNDARIES +C ADDED VIRTUAL MOMENTUM SOURCES AND SINKS FOR SUBGRID SCALE CHANNEL +C INTERACTIONS, INCLUDING LOCAL VARIABLES TMPVEC1,TMPVEC2,QMCSINKX, +C QMCSINKY,QMCSOURX,QMSOURY +C ADDED DRY CELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES +C +C 2008-12 SANG YUK/PMC (DSLLC) CORRECTED THE EXPLICIT INTERNAL BUOYANCY FORCINGS +C + USE GLOBAL + USE MPI + + IMPLICIT NONE + INTEGER::L,K,LN,LS,ID,JD,KD,NWR,IU,JU,KU,LU,NS,LNW,LSE,LL + INTEGER::LD,NMD,LHOST,LCHNU,LW,LE,LCHNV + REAL::TMPANG,WU,WV,CACSUM,CFEFF,VEAST2,VWEST2,FCORE,FCORW + REAL::UNORT1,USOUT1,UNORT2,USOUT2,FCORN,FCORS,VTMPATU + REAL::UTMPATV,UMAGTMP,VMAGTMP,DZICK,DZICKC,DZPU,DZPV + REAL::RCDZF,TMPVAL,WVFACT,DETH,CI11H,CI12H,CI22H,DETU + REAL::CI11V,CI12V,CI21V,CI22V,CI21H,CI12U,CI21U,CI22U,DETV,CI11U + REAL::UHC,UHB,VHC,VHB,UHC1,UHB1,VHC1,VHB1,UHC2,UHB2,VHC2,VHB2 + REAL::UHB1MX,UHB1MN,VHC1MX,VHC1MN,UHC1MX,UHC1MN,VHB1MX + REAL::VHB1MN,UHB2MX,UHB2MN,VHC2MX,VHC2MN,UHC2MX,UHC2MN,VHB2MX + REAL::VHB2MN,BOTT,QMF,QUMF,VEAST1,VWEST1 + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::DZPC + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPVEC1 + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPVEC2 + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FUHJ + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FVHJ + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSINKX + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSINKY + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSOURX + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSOURY +C + IF(.NOT.ALLOCATED(TMPVEC1))THEN + ALLOCATE(FUHJ(LCM,KCM)) + ALLOCATE(FVHJ(LCM,KCM)) + ALLOCATE(QMCSINKX(LCM,KCM)) + ALLOCATE(QMCSINKY(LCM,KCM)) + ALLOCATE(QMCSOURX(LCM,KCM)) + ALLOCATE(QMCSOURY(LCM,KCM)) + ALLOCATE(TMPVEC1(KCM)) + ALLOCATE(TMPVEC2(KCM)) + ALLOCATE(DZPC(LCM,KCM)) + FUHJ=0. + FVHJ=0. + QMCSINKX=0. + QMCSINKY=0. + QMCSOURX=0. + QMCSOURY=0. + TMPVEC1=0. + TMPVEC2=0. + DZPC=0. + ENDIF +C + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + ENDIF +C + IF(IS2TIM.EQ.2)THEN + DELT=0.5*DT + ENDIF +C + DELTI=1./DELT +C + IF(MYRANK.EQ.0.AND.N.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='MFLUX.DIA') + CLOSE(1,STATUS='DELETE') + ENDIF +C +C**********************************************************************C +C +C ** INITIALIZE MOMENTUM FLUXES AND CORIOLIS TERMS +C ** INITIALIZE EXTERNAL CORIOLIS-CURVATURE AND ADVECTIVE FLUX TERMS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FCAXE(L)=0. + FCAYE(L)=0. + FXE(L)=0. + FYE(L)=0. + ENDDO + MPI_WTIMES(301)=MPI_WTIMES(301)+MPI_TOC(S1TIME) +C +C +C----------------------------------------------------------------------C +C + + IF(IS2LMC.NE.1)THEN + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,LS,UHC,UHB,VHC,VHB) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + + UHC=0.5*(UHDY(L,K)+UHDY(LS,K)) + UHB=0.5*(UHDY(L,K)+UHDY(L+1,K)) + VHC=0.5*(VHDX(L,K)+VHDX(L-1,K)) + VHB=0.5*(VHDX(L,K)+VHDX(LN,K)) +C + FUHU(L,K)=MAX(UHB,0.)*U(L, K) ! *** CELL CENTERED + & +MIN(UHB,0.)*U(L+1,K) + FVHU(L,K)=MAX(VHC,0.)*U(LS, K) + & +MIN(VHC,0.)*U(L, K) +C + FVHV(L,K)=MAX(VHB,0.)*V(L, K) ! *** CELL CENTERED + & +MIN(VHB,0.)*V(LN, K) + FUHV(L,K)=MAX(UHC,0.)*V(L-1,K) + & +MIN(UHC,0.)*V(L, K) + ELSE + FUHU(L,K)=0. + FVHU(L,K)=0. + FVHV(L,K)=0. + FUHV(L,K)=0. + ENDIF + ENDDO + ENDDO + MPI_WTIMES(302)=MPI_WTIMES(302)+MPI_TOC(S1TIME) +C + ELSE !IF(IS2LMC.EQ.1)THEN +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN,LS,UHC1,UHB1,VHC1,VHB1,UHC2,UHB2,VHC2,VHB2 +!$OMP+ ,UHB1MX,UHB1MN,VHC1MX,VHC1MN,VHB1MX,VHB1MN,UHB2MX,UHB2MN,VHC2MX +!$OMP+ ,VHC2MN,UHC2MX,UHC2MN,VHB2MX,VHB2MN,BOTT) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + UHC1=0.5*(UHDY(L,1)+UHDY(LS,1)) + UHB1=0.5*(UHDY(L,1)+UHDY(L+1,1)) + VHC1=0.5*(VHDX(L,1)+VHDX(L-1,1)) + VHB1=0.5*(VHDX(L,1)+VHDX(LN,1)) + UHC2=0.5*(UHDY(L,2)+UHDY(LS,2)) + UHB2=0.5*(UHDY(L,2)+UHDY(L+1,2)) + VHC2=0.5*(VHDX(L,2)+VHDX(L-1,2)) + VHB2=0.5*(VHDX(L,2)+VHDX(LN,2)) +C + UHB1MX=0. + UHB1MN=0. + VHC1MX=0. + VHC1MN=0. + UHC1MX=0. + UHC1MN=0. + VHB1MX=0. + VHB1MN=0. + UHB2MX=0. + UHB2MN=0. + VHC2MX=0. + VHC2MN=0. + UHC2MX=0. + UHC2MN=0. + VHB2MX=0. + VHB2MN=0. +C + BOTT=ABS(UHB1*U(L,1)) + IF(BOTT.GT.0.0) + & UHB1MX=1.+CK2UUM*(UHB2-UHB1)*(U(L,2)-U(L,1))/UHB1*U(L,1) + BOTT=ABS(UHB1*U(L+1,1)) + IF(BOTT.GT.0.0) + & UHB1MN=1.+CK2UUM*(UHB2-UHB1)*(U(L+1,2)-U(L+1,1))/ + & UHB1*U(L+1,1) + BOTT=ABS(VHC1*U(LS,1)) + IF(BOTT.GT.0.0) + & VHC1MX=1.+CK2UVM*(VHC2-VHC1)*(U(LS,2)-U(LS,1))/VHC1* + & U(LS,1) + BOTT=ABS(VHC1*U(L,1)) + IF(BOTT.GT.0.0) + & VHC1MN=1.+CK2UVM*(VHC2-VHC1)*(U(L,2)-U(L,1))/VHC1*U(L,1) + BOTT=ABS(UHC1*V(L-1,1)) + IF(BOTT.GT.0.0) + & UHC1MX=1.+CK2UVM*(UHC2-UHC1)*(V(L-1,2)-V(L-1,1))/ + & UHC1*V(L-1,1) + BOTT=ABS(UHC1*V(L,1)) + IF(BOTT.GT.0.0) + & UHC1MN=1.+CK2UVM*(UHC2-UHC1)*(V(L,2)-V(L,1))/UHC1*V(L,1) + BOTT=ABS(VHB1*V(L,1)) + IF(BOTT.GT.0.0) + & VHB1MX=1.+CK2VVM*(VHB2-VHB1)*(V(L,2)-V(L,1))/VHB1*V(L,1) + BOTT=ABS(VHB1*V(LN,1)) + IF(BOTT.GT.0.0) + & VHB1MN=1.+CK2VVM*(VHB2-VHB1)*(V(LN,2)-V(LN,1))/VHB1* + & V(LN,1) + + BOTT=ABS(UHB2*U(L,2)) + IF(BOTT.GT.0.0) + & UHB2MX=1.+CK2UUM*(UHB2-UHB1)*(U(L,2)-U(L,1))/UHB2*U(L,2) + BOTT=ABS(UHB2*U(L+1,2)) + IF(BOTT.GT.0.0) + & UHB2MN=1.+CK2UUM*(UHB2-UHB1)*(U(L+1,2)-U(L+1,1))/ + & UHB2*U(L+1,2) + BOTT=ABS(VHC2*U(LS,2)) + IF(BOTT.GT.0.0) + & VHC2MX=1.+CK2UVM*(VHC2-VHC1)*(U(LS,2)-U(LS,1))/VHC2* + & U(LS,2) + BOTT=ABS(VHC2*U(L,2)) + IF(BOTT.GT.0.0) + & VHC2MN=1.+CK2UVM*(VHC2-VHC1)*(U(L,2)-U(L,1))/VHC2*U(L,2) + BOTT=ABS(UHC2*V(L-1,2)) + IF(BOTT.GT.0.0) + & UHC2MX=1.+CK2UVM*(UHC2-UHC1)*(V(L-1,2)-V(L-1,1))/ + & UHC2*V(L-1,2) + BOTT=ABS(UHC2*V(L,2)) + IF(BOTT.GT.0.0) + & UHC2MN=1.+CK2UVM*(UHC2-UHC1)*(V(L,2)-V(L,1))/UHC2*V(L,2) + BOTT=ABS(VHB2*V(L,2)) + IF(BOTT.GT.0.0) + & VHB2MX=1.+CK2VVM*(VHB2-VHB1)*(V(L,2)-V(L,1))/VHB2*V(L,2) + BOTT=ABS(VHB2*V(LN,2)) + IF(BOTT.GT.0.0) + & VHB2MN=1.+CK2VVM*(VHB2-VHB1)*(V(LN,2)-V(LN,1))/VHB2* + & V(LN,2) +C + FUHU(L,1)=UHB1MX*MAX(UHB1,0.)*U(L,1) + & +UHB1MN*MIN(UHB1,0.)*U(L+1,1) + FVHU(L,1)=VHC1MX*MAX(VHC1,0.)*U(LS,1) + & +VHC1MN*MIN(VHC1,0.)*U(L,1) + FUHV(L,1)=UHC1MX*MAX(UHC1,0.)*V(L-1,1) + & +UHC1MN*MIN(UHC1,0.)*V(L,1) + FVHV(L,1)=VHB1MX*MAX(VHB1,0.)*V(L,1) + & +VHB1MN*MIN(VHB1,0.)*V(LN,1) + FUHJ(L,1)=0. + FVHJ(L,1)=0. + FUHU(L,2)=UHB2MX*MAX(UHB2,0.)*U(L,2) + & +UHB2MN*MIN(UHB2,0.)*U(L+1,2) + FVHU(L,2)=VHC2MX*MAX(VHC2,0.)*U(LS,2) + & +VHC2MN*MIN(VHC2,0.)*U(L,2) + FUHV(L,2)=UHC2MX*MAX(UHC2,0.)*V(L-1,2) + & +UHC2MN*MIN(UHC2,0.)*V(L,2) + FVHV(L,2)=VHB2MX*MAX(VHB2,0.)*V(L,2) + & +VHB2MN*MIN(VHB2,0.)*V(LN,2) + FUHJ(L,2)=0. + FVHJ(L,2)=0. + ENDIF + ENDDO + MPI_WTIMES(329)=MPI_WTIMES(329)+MPI_TOC(S1TIME) + ENDIF +C +C ADD RETURN FLOW MOMENTUM FLUX +C + S1TIME=MPI_TIC() + DO NWR=1,NQWR + IF(NQWRMFU(NWR).GT.0)THEN + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + LU=LIJ(IU,JU) + NS=NQWRSERQ(NWR) + QMF=QWR(NWR)+QWRSERT(NS) + QUMF=QMF*QMF/(H1P(LU)*DZC(KU)*DZC(KU)*BQWRMFU(NWR)) + IF(NQWRMFU(NWR).EQ.1) FUHJ(LU ,KU)=QUMF + IF(NQWRMFU(NWR).EQ.2) FVHJ(LU ,KU)=QUMF + IF(NQWRMFU(NWR).EQ.3) FUHJ(LU+1 ,KU)=QUMF + IF(NQWRMFU(NWR).EQ.4) FVHJ(LNC(LU),KU)=QUMF + IF(NQWRMFU(NWR).EQ.-1) FUHJ(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-2) FVHJ(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-3) FUHJ(LU+1 ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-4) FVHJ(LNC(LU),KU)=-QUMF + ENDIF + IF(NQWRMFD(NWR).GT.0)THEN + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LD=LIJ(ID,JD) + TMPANG=0.017453*ANGWRMFD(NWR) + TMPANG=COS(TMPANG) + NS=NQWRSERQ(NWR) + QMF=QWR(NWR)+QWRSERT(NS) + QUMF=TMPANG*QMF*QMF/(H1P(LD)*DZC(KD)*DZC(KD)*BQWRMFD(NWR)) + IF(NQWRMFD(NWR).EQ.1) FUHJ(LD ,KD)=-QUMF + IF(NQWRMFD(NWR).EQ.2) FVHJ(LD ,KD)=-QUMF + IF(NQWRMFD(NWR).EQ.3) FUHJ(LD+1 ,KD)=-QUMF + IF(NQWRMFD(NWR).EQ.4) FVHJ(LNC(LD),KD)=-QUMF + IF(NQWRMFD(NWR).EQ.-1) FUHJ(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-2) FVHJ(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-3) FUHJ(LD+1 ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-4) FVHJ(LNC(LD),KD)=QUMF + ENDIF + ENDDO + MPI_WTIMES(330)=MPI_WTIMES(330)+MPI_TOC(S1TIME) +C +C----------------------------------------------------------------------C +C +C *** COMPUTE VERTICAL ACCELERATIONS +C + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS,WU,WV) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) + WV=0.5*DXYV(L)*(W(L,K)+W(LS,K)) + + FWU(L,K)=MAX(WU,0.)*U(L,K) + & +MIN(WU,0.)*U(L,K+1) + FWV(L,K)=MAX(WV,0.)*V(L,K) + & +MIN(WV,0.)*V(L,K+1) + ELSE + FWU(L,K)=0. + FWV(L,K)=0. + ENDIF + + ENDDO + ENDDO + MPI_WTIMES(303)=MPI_WTIMES(303)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** BLOCK MOMENTUM FLUX ON LAND SIDE OF TRIANGULAR CELLS +C + S1TIME=MPI_TIC() + IF(ITRICELL.GT.0)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILA + FUHU(L,K)=STCUV(L)*FUHU(L,K) + FVHV(L,K)=STCUV(L)*FVHV(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(304)=MPI_WTIMES(304)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FVHV,ic) + CALL broadcast_boundary_array(FUHV,ic) + CALL broadcast_boundary_array(FWU,ic) + CALL broadcast_boundary_array(FWV,ic) + MPI_WTIMES(331)=MPI_WTIMES(331)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** CALCULATE CORIOLIS AND CURVATURE ACCELERATION COEFFICIENTS +C +C----------------------------------------------------------------------C +C + CACSUM=0. + CFMAX=CF + IF(ISCURVATURE)THEN + IF(ISDCCA.EQ.0)THEN +C + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN) REDUCTION(+:CACSUM) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + CAC(L,K)=( FCORC(L)*DXYP(L) + & +0.5*SNLT*(V(LN,K)+V(L,K))*DYDI(L) + & -0.5*SNLT*(U(L+1,K)+U(L,K))*DXDJ(L) )*HP(L) + ELSE + CAC(L,K)=0.0 ! *** DSLLC SINGLE LINE + ENDIF + CACSUM=CACSUM+CAC(L,K) + ENDDO + ENDDO + MPI_WTIMES(305)=MPI_WTIMES(305)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(CAC,ic) + CALL MPI_ALLREDUCE(CACSUM,MPI_R4,1,MPI_REAL,MPI_SUM, + & MPI_COMM_WORLD,IERR) + CACSUM=MPI_R4 + MPI_WTIMES(332)=MPI_WTIMES(332)+MPI_TOC(S1TIME) +C + ELSE +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,CFEFF) REDUCTION(+:CACSUM) +!$OMP+ REDUCTION(MAX:CFMAX) + DO L=LMPI2,LMPILA + LN=LNC(L) + CAC(L,K)=( FCORC(L)*DXYP(L) + & +0.5*SNLT*(V(LN,K)+V(L,K))*DYDI(L) + & -0.5*SNLT*(U(L+1,K)+U(L,K))*DXDJ(L) )*HP(L) + CFEFF=ABS(CAC(L,K))*DXYIP(L)*HPI(L) + CFMAX=MAX(CFMAX,CFEFF) + CACSUM=CACSUM+CAC(L,K) + ENDDO + ENDDO + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(CAC,ic) + CALL MPI_ALLREDUCE(CACSUM,MPI_R4,1,MPI_REAL,MPI_SUM, + & MPI_COMM_WORLD,IERR) + CACSUM=MPI_R4 + MPI_WTIMES(333)=MPI_WTIMES(333)+MPI_TOC(S1TIME) +C + IF(MYRANK.EQ.0.AND.N.EQ.NTS.AND.DEBUG)THEN + OPEN(1,FILE='CORC1.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CORC1.DIA') + K=1 + DO L=2,LA + LN=LNC(L) + WRITE(1,1111)IL(L),JL(L),LN,V(LN,K),V(L,K),DYU(L+1), + & DYU(L),U(L+1,K),U(L,K),DXV(LN),DXV(L),HP(L),CAC(L,K) + ENDDO + CLOSE(1) + ENDIF + + ENDIF + + ! *** ENSURE FCAY & FCAX ARE RESET + S1TIME=MPI_TIC() + CACSUM=ABS(CACSUM) + IF(CACSUM.LT.1.E-7)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FCAX(L,K)=0. + FCAY(L,K)=0. + ENDDO + ENDDO + ENDIF + MPI_WTIMES(306)=MPI_WTIMES(306)+MPI_TOC(S1TIME) + ENDIF +C + 1111 FORMAT(3I5,10E13.4) + 1113 FORMAT(2I5,10E13.4) +C +C**********************************************************************C +C +C ** CALCULATE CORIOLIS-CURVATURE AND ADVECTIVE ACCELERATIONS +C +C----------------------------------------------------------------------C +C +C ** STANDARD CALCULATION +C + IF(IS2LMC.EQ.0.AND.CACSUM.GT.1.E-7)THEN + + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,LS,LNW,LSE) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + FCAX(L,K)=0.25*SCAX(L)*(CAC(L,K)*(V(LN,K)+V(L,K)) + & +CAC(L-1,K)*(V(LNW,K)+V(L-1,K))) + FCAY(L,K)=0.25*SCAY(L)*(CAC(L,K)*(U(L+1,K)+U(L,K)) + & +CAC(LS,K)*(U(LSE,K)+U(LS,K))) + ELSE + FCAX(L,K)=0. + FCAY(L,K)=0. + ENDIF + ENDDO + ENDDO + MPI_WTIMES(307)=MPI_WTIMES(307)+MPI_TOC(S1TIME) +C +C----------------------------------------------------------------------C +C +C ** MODIFICATION FOR TYPE 2 OPEN BOUNDARIES +C + S1TIME=MPI_TIC() + DO LL=1,NPBW + IF(ISPBW(LL).EQ.2)THEN + L=LPBW(LL)+1 + LN=LNC(L) + DO K=1,KC + FCAX(L,K)=0.5*SCAX(L)*CAC(L,K)*(V(LN,K)+V(L,K)) + ENDDO + ENDIF + ENDDO +C + DO LL=1,NPBE + IF(ISPBE(LL).EQ.2)THEN + L=LPBE(LL) + LNW=LNWC(L) + DO K=1,KC + FCAX(L,K)=0.5*SCAX(L)*CAC(L-1,K)*(V(LNW,K)+V(L-1,K)) + ENDDO + ENDIF + ENDDO +C + DO LL=1,NPBS + IF(ISPBS(LL).EQ.2)THEN + L=LNC(LPBS(LL)) + DO K=1,KC + FCAY(L,K)=0.5*SCAY(L)*CAC(L,K)*(U(L+1,K)+U(L,K)) + ENDDO + ENDIF + ENDDO +C + DO LL=1,NPBN + IF(ISPBN(LL).EQ.2)THEN + L=LPBN(LL) + LS=LSC(L) + LSE=LSEC(L) + DO K=1,KC + FCAY(L,K)=0.5*SCAY(L)*CAC(LS,K)*(U(LSE,K)+U(LS,K)) + ENDDO + ENDIF + ENDDO + MPI_WTIMES(308)=MPI_WTIMES(308)+MPI_TOC(S1TIME) + + ENDIF +C +C----------------------------------------------------------------------C +C +C *** CALCULATION FOR MOMENTUM-CURVATURE CORRECTION +C *** PMC - USED TO BE ONLY FOR 2 LAYERS, JH ALLOWED ANY # OF LAYERS +C + IF(IS2LMC.EQ.1.AND.CACSUM.GT.1.E-7)THEN +CJH IF(KC.EQ.2)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN,LS,LNW,LSE,VEAST1,VWEST1,VEAST2,VWEST2, +!$OMP+ FCORE,FCORW,UNORT1,USOUT1,UNORT2,USOUT2,FCORN,FCORS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) +C + VEAST1=V(LN,1)+V(L,1) + VWEST1=V(LNW,1)+V(L-1,1) + VEAST2=V(LN,2)+V(L,2) + VWEST2=V(LNW,2)+V(L-1,2) + FCORE=CK2FCX*(CAC(L,2)-CAC(L,1))*(VEAST2-VEAST1) + FCORW=CK2FCX*(CAC(L-1,2)-CAC(L-1,1))*(VWEST2-VWEST1) +C + FCAX(L,1)=0.25*SCAX(L)*( + & CAC(L,1)*VEAST1+FCORE + & +CAC(L-1,1)*VWEST1+FCORW) +C + FCAX(L,2)=0.25*SCAX(L)*( + & CAC(L,2)*VEAST2+FCORE + & +CAC(L-2,2)*VWEST2+FCORW) +C + UNORT1=U(L+1,1)+U(L,1) + USOUT1=U(LSE,1)+U(LS,1) + UNORT2=U(L+1,2)+U(L,2) + USOUT2=U(LSE,2)+U(LS,2) + FCORN=CK2FCY*(CAC(L,2)-CAC(L,1))*(UNORT2-UNORT1) + FCORS=CK2FCY*(CAC(LS,2)-CAC(LS,1))*(USOUT2-USOUT1) +C + FCAY(L,1)=0.25*SCAY(L)*( + & CAC(L,1)*UNORT1+FCORN + & +CAC(LS,1)*USOUT1+FCORS) +C + FCAY(L,2)=0.25*SCAY(L)*( + & CAC(L,2)*UNORT2+FCORN + & +CAC(LS,2)*USOUT2+FCORS) +C + ENDIF + ENDDO + MPI_WTIMES(309)=MPI_WTIMES(309)+MPI_TOC(S1TIME) + ENDIF +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,LS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + FX(L,K)=(FUHU(L,K)-FUHU(L-1,K)+FVHU(LN,K)-FVHU(L,K) + & +FUHJ(L,K) ) + FY(L,K)=(FUHV(L+1,K)-FUHV(L,K)+FVHV(L,K)-FVHV(LS,K) + & +FVHJ(L,K) ) + ELSE + FX(L,K)=0. + FY(L,K)=0. + ENDIF + ENDDO + ENDDO + MPI_WTIMES(310)=MPI_WTIMES(310)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + ! *** TREAT BC'S NEAR EDGES + DO LL=1,NBCS + ! *** BC CELL + L=LBCS(LL) + !DO K=1,KC + FX(L,1:KC)=SAAX(L)*FX(L,1:KC) + FY(L,1:KC)=SAAY(L)*FY(L,1:KC) + !ENDDO + + ! *** EAST/WEST ADJACENT CELL + L=LBERC(LL) + !DO K=1,KC + FX(L,1:KC)=SAAX(L)*FX(L,1:KC) + !ENDDO + + ! *** NORTH/SOUTH ADJACENT CELL + L=LBNRC(LL) + !DO K=1,KC + FY(L,1:KC)=SAAY(L)*FY(L,1:KC) + !ENDDO + ENDDO + MPI_WTIMES(311)=MPI_WTIMES(311)+MPI_TOC(S1TIME) +C +C----------------------------------------------------------------------C +C +C ** CORIOLIS-CURVATURE DIAGNOSTICS +C + S1TIME=MPI_TIC() + IF(ISDCCA.EQ.1.AND.DEBUG)THEN + IF(MYRANK.EQ.0.AND.N.EQ.NTS)THEN + OPEN(1,FILE='CORC2.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CORC2.DIA') + K=1 + DO L=2,LA + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + WRITE(1,1113)IL(L),JL(L),CAC(L,K),V(LN,K),V(L,K), + & CAC(L-1,K),V(LNW,K),V(L-1,K) + ENDDO + CLOSE(1) + ENDIF +C + IF(MYRANK.EQ.0.AND.N.EQ.NTS)THEN + OPEN(1,FILE='CORC3.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CORC3.DIA') + K=1 + DO L=2,LA + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + WRITE(1,1113)IL(L),JL(L),CAC(L,K),U(L+1,K),U(L,K), + & CAC(LS,K),U(LSE,K),U(LS,K) + ENDDO + CLOSE(1) + ENDIF +C + IF(MYRANK.EQ.0.AND.N.EQ.NTS)THEN + OPEN(1,FILE='CORC4.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CORC4.DIA') + DO L=2,LA + WRITE(1,1113)IL(L),JL(L),(FCAX(L,K),K=1,KC) + ENDDO + DO L=2,LA + WRITE(1,1113)IL(L),JL(L),(FCAY(L,K),K=1,KC) + ENDDO + CLOSE(1) + ENDIF + ENDIF + MPI_WTIMES(312)=MPI_WTIMES(312)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** ADD VEGETATION DRAG TO HORIZONTAL ADVECTIVE ACCELERATIONS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(ISVEG.GE.1)THEN +C +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FXVEGE(L)=0. + FYVEGE(L)=0. + ENDDO +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LW,LE,LS,LN,LNW,LSE, +!$OMP+ VTMPATU,UTMPATV,UMAGTMP,VMAGTMP) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LW=L-1 + LE=L+1 + LS=LSC(L) + LN=LNC(L) + LNW=LNWC(L) + LSE=LSEC(L) + VTMPATU=0.25*(V(L,K)+V(LW,K)+V(LN,K)+V(LNW,K)) + UTMPATV=0.25*(U(L,K)+U(LE,K)+U(LS,K)+U(LSE,K)) + UMAGTMP=SQRT( U(L,K)*U(L,K)+VTMPATU*VTMPATU ) + VMAGTMP=SQRT( UTMPATV*UTMPATV+V(L,K)*V(L,K) ) + FXVEG(L,K)=UMAGTMP*SUB(L)*DXYU(L)*FXVEG(L,K) + FYVEG(L,K)=VMAGTMP*SVB(L)*DXYV(L)*FYVEG(L,K) + FXVEGE(L)=FXVEGE(L)+FXVEG(L,K)*DZC(K) + FYVEGE(L)=FYVEGE(L)+FYVEG(L,K)*DZC(K) + ENDIF + ENDDO + ENDDO +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FXVEG(L,K)=FXVEG(L,K)*U(L,K) + FYVEG(L,K)=FYVEG(L,K)*V(L,K) + FX(L,K)=FX(L,K)+FXVEG(L,K)-FXVEGE(L)*U(L,K) + FY(L,K)=FY(L,K)+FYVEG(L,K)-FYVEGE(L)*V(L,K) + ENDIF + ENDDO + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FXVEGE(L)=DXYIU(L)*FXVEGE(L)/HU(L) + FYVEGE(L)=DXYIV(L)*FYVEGE(L)/HV(L) + ENDDO +C + ENDIF + MPI_WTIMES(313)=MPI_WTIMES(313)+MPI_TOC(S1TIME) +C +C1947 FORMAT(3I5,10E12.4) +C1948 FORMAT(15X,10E12.4) +C +C**********************************************************************C +C +C ** ADD HORIZONTAL MOMENTUM DIFFUSION TO ADVECTIVE ACCELERATIONS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(ISHDMF.GE.1)THEN +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FX(L,K)=FX(L,K)-(FMDUX(L,K)+FMDUY(L,K)) + FY(L,K)=FY(L,K)-(FMDVX(L,K)+FMDVY(L,K)) + ENDIF + ENDDO + ENDDO +C + ENDIF + MPI_WTIMES(314)=MPI_WTIMES(314)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** ADD BODY FORCE TO ADVECTIVE ACCELERATIONS +C ** DISTRIBUTE UNIFORMLY OVER ALL LAYERS IF ISBODYF=1 +C ** DISTRIBUTE OVER SURFACE LAYER IF ISBODYF=2 +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(ISBODYF.EQ.1)THEN +C + DO K=1,KC + DZICK=1./DZC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FX(L,K)=FX(L,K)-DYU(L)*HU(L)*FBODYFX(L) + FY(L,K)=FY(L,K)-DXV(L)*HV(L)*FBODYFY(L) + ENDDO + ENDDO +C + ENDIF + MPI_WTIMES(315)=MPI_WTIMES(315)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(ISBODYF.EQ.2)THEN +C + DZICKC=1./DZC(KC) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FX(L,KC)=FX(L,KC)-DZICKC*DYU(L)*HU(L)*FBODYFX(L) + FY(L,KC)=FY(L,KC)-DZICKC*DXV(L)*HV(L)*FBODYFY(L) + ENDDO +C + ENDIF + MPI_WTIMES(316)=MPI_WTIMES(316)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** ADD EXPLICIT NONHYDROSTATIC PRESSURE +C + S1TIME=MPI_TIC() + IF(KC.GT.1.AND.ISPNHYDS.GE.1) THEN +C + TMPVAL=2./(DZC(1)+DZC(2)) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DZPC(L,1)=TMPVAL*(PNHYDS(L,2)-PNHYDS(L,1)) + ENDDO +C + TMPVAL=2./(DZC(KC)+DZC(KC-1)) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DZPC(L,KC)=TMPVAL*(PNHYDS(L,KC)-PNHYDS(L,KC-1)) + ENDDO + + IF(KC.GE.3)THEN + DO K=2,KS + TMPVAL=2./(DZC(K+1)+2.*DZC(K)+DZC(K-1)) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DZPC(L,K)=TMPVAL*(PNHYDS(L,K+1)-PNHYDS(L,K-1)) + ENDDO + ENDDO + ENDIF +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS,DZPU,DZPV) + DO L=LMPI2,LMPILA + LS=LSC(L) + DZPU=0.5*(DZPC(L,K)+DZPC(L-1,K)) + DZPV=0.5*(DZPC(L,K)+DZPC(LS ,K)) + FX(L,K)=FX(L,K)+SUB(L)*DYU(L)* + & ( HU(L)*(PNHYDS(L,K)-PNHYDS(L-1,K)) + & -( BELV(L)-BELV(L-1)+ZZ(K)*(HP(L)-HP(L-1)) )*DZPU ) + FY(L,K)=FY(L,K)+SVB(L)*DXV(L)* + & ( HV(L)*(PNHYDS(L,K)-PNHYDS(LS ,K)) + & -( BELV(L)-BELV(LS )+ZZ(K)*(HP(L)-HP(LS )) )*DZPV ) + ENDDO + ENDDO +C + ENDIF + MPI_WTIMES(317)=MPI_WTIMES(317)+MPI_TOC(S1TIME) +C +C----------------------------------------------------------------------C +C +C ** ADD NET WAVE REYNOLDS STRESSES TO EXTERNAL ADVECTIVE ACCEL. +C +C *** DSLLC BEGIN BLOCK + S1TIME=MPI_TIC() + IF(ISWAVE.EQ.2)THEN +C + IF(N.LT.NTSWV)THEN + TMPVAL=FLOAT(N)/FLOAT(NTSWV) + WVFACT=0.5-0.5*COS(PI*TMPVAL) + ELSE + WVFACT=1.0 + ENDIF +C + IF(ISDRY.GT.0)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FX(L,K)=FX(L,K)+WVFACT*SAAX(L)*FXWAVE(L,K) + FY(L,K)=FY(L,K)+WVFACT*SAAY(L)*FYWAVE(L,K) + ENDIF + ENDDO + ENDDO + ELSE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FX(L,K)=FX(L,K)+WVFACT*SAAX(L)*FXWAVE(L,K) + FY(L,K)=FY(L,K)+WVFACT*SAAY(L)*FYWAVE(L,K) + ENDDO + ENDDO + ENDIF +C + ENDIF + MPI_WTIMES(318)=MPI_WTIMES(318)+MPI_TOC(S1TIME) +C *** DSLLC END BLOCK +C +C**********************************************************************C +C +C ** CALCULATE EXTERNAL ACCELERATIONS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(ISDRY.GT.0)THEN !! ISDRY = 99 + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) + FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) + FXE(L)=FXE(L)+FX(L,K)*DZC(K) + FYE(L)=FYE(L)+FY(L,K)*DZC(K) + ENDIF + ENDDO + ENDDO + ELSE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) + FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) + FXE(L)=FXE(L)+FX(L,K)*DZC(K) + FYE(L)=FYE(L)+FY(L,K)*DZC(K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(319)=MPI_WTIMES(319)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** COMPLETE CALCULATION OF INTERNAL ADVECTIVE ACCELERATIONS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(KC.GT.1)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FX(L,K)=FX(L,K)+SAAX(L)*(FWU(L,K)-FWU(L,K-1))*DZIC(K) + FY(L,K)=FY(L,K)+SAAY(L)*(FWV(L,K)-FWV(L,K-1))*DZIC(K) + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(320)=MPI_WTIMES(320)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** ADD SUBGRID SCALE CHANNEL VIRTURAL MOMENTUM SOURCES AND SINKS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + QMCSOURX(L,K)=0. + QMCSOURY(L,K)=0. + QMCSINKX(L,K)=0. + QMCSINKY(L,K)=0. + ENDDO + ENDDO +C + DO NMD=1,MDCHH +C + LHOST=LMDCHH(NMD) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) +C + DETH=CUE(LHOST)*CVN(LHOST)-CUN(LHOST)*CVE(LHOST) + CI11H=CVN(LHOST)/DETH + CI12H=-CUN(LHOST)/DETH + CI21H=-CVE(LHOST)/DETH + CI22H=CUE(LHOST)/DETH +C + DETU=CUE(LCHNU)*CVN(LCHNU)-CUN(LCHNU)*CVE(LCHNU) + CI11U=CVN(LCHNU)/DETU + CI12U=-CUN(LCHNU)/DETU + CI21U=-CVE(LCHNU)/DETU + CI22U=CUE(LCHNU)/DETU +C + DETV=CUE(LCHNV)*CVN(LCHNV)-CUN(LCHNV)*CVE(LCHNV) + CI11V=CVN(LCHNV)/DETV + CI12V=-CUN(LCHNV)/DETV + CI21V=-CVE(LCHNV)/DETV + CI22V=CUE(LCHNV)/DETV +C +C X-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.1)THEN + IF(QCHANU(NMD).GT.0.0)THEN + DO K=1,KC + QMCSINKX(LCHNU,K)=QMCSINKX(LCHNU,K) + & -0.5*DZC(K)*QCHANU(NMD)*(U(LCHNU,K)+U(LCHNU+1,K)) + QMCSINKY(LCHNU,K)=QMCSINKY(LCHNU,K) + & -0.5*DZC(K)*QCHANU(NMD)*(V(LCHNU,K)+V(LNC(LCHNU),K)) + ENDDO + DO K=1,KC + TMPVEC1(K)=CUE(LCHNU)*QMCSINKX(LCHNU,K) + & +CVE(LCHNU)*QMCSINKY(LCHNU,K) + TMPVEC2(K)=CUN(LCHNU)*QMCSINKX(LCHNU,K) + & +CVN(LCHNU)*QMCSINKY(LCHNU,K) + ENDDO + DO K=1,KC + QMCSOURX(LHOST,K)=QMCSOURX(LHOST,K) + & +CI11H*TMPVEC1(K)+CI12H*TMPVEC2(K) + QMCSOURY(LHOST,K)=QMCSOURY(LHOST,K) + & +CI21H*TMPVEC1(K)+CI22H*TMPVEC2(K) + ENDDO + ELSE + DO K=1,KC + QMCSINKX(LHOST,K)=QMCSINKX(LHOST,K) + & +0.5*DZC(K)*QCHANU(NMD)*(U(LHOST,K)+U(LHOST+1,K)) + QMCSINKY(LHOST,K)=QMCSINKY(LCHNU,K) + & +0.5*DZC(K)*QCHANU(NMD)*(V(LHOST,K)+V(LNC(LHOST),K)) + ENDDO + DO K=1,KC + TMPVEC1(K)=CUE(LHOST)*QMCSINKX(LHOST,K) + & +CVE(LHOST)*QMCSINKY(LHOST,K) + TMPVEC2(K)=CUN(LHOST)*QMCSINKX(LCHNU,K) + & +CVN(LHOST)*QMCSINKY(LHOST,K) + ENDDO + DO K=1,KC + QMCSOURX(LCHNU,K)=QMCSOURX(LCHNU,K) + & -CI11U*TMPVEC1(K)-CI12U*TMPVEC2(K) + QMCSOURY(LCHNU,K)=QMCSOURY(LCHNU,K) + & -CI21U*TMPVEC1(K)-CI22U*TMPVEC2(K) + ENDDO + ENDIF + ENDIF +C +C Y-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.2)THEN + IF(QCHANV(NMD).GT.0.0)THEN + DO K=1,KC + QMCSINKX(LCHNV,K)=QMCSINKX(LCHNV,K) + & -0.5*DZC(K)*QCHANV(NMD)*(U(LCHNV,K)+U(LCHNV+1,K)) + QMCSINKY(LCHNV,K)=QMCSINKY(LCHNV,K) + & -0.5*DZC(K)*QCHANV(NMD)*(V(LCHNV,K)+V(LNC(LCHNV),K)) + ENDDO + DO K=1,KC + TMPVEC1(K)=CUE(LCHNV)*QMCSINKX(LCHNV,K) + & +CVE(LCHNV)*QMCSINKY(LCHNV,K) + TMPVEC2(K)=CUN(LCHNV)*QMCSINKX(LCHNV,K) + & +CVN(LCHNV)*QMCSINKY(LCHNV,K) + ENDDO + DO K=1,KC + QMCSOURX(LHOST,K)=QMCSOURX(LHOST,K) + & +CI11H*TMPVEC1(K)+CI12H*TMPVEC2(K) + QMCSOURY(LHOST,K)=QMCSOURY(LHOST,K) + & +CI21H*TMPVEC1(K)+CI22H*TMPVEC2(K) + ENDDO + ELSE + DO K=1,KC + QMCSINKX(LHOST,K)=QMCSINKX(LHOST,K) + & +0.5*DZC(K)*QCHANV(NMD)*(U(LHOST,K)+U(LHOST+1,K)) + QMCSINKY(LHOST,K)=QMCSINKY(LCHNV,K) + & +0.5*DZC(K)*QCHANV(NMD)*(V(LHOST,K)+V(LNC(LHOST),K)) + ENDDO + DO K=1,KC + TMPVEC1(K)=CUE(LHOST)*QMCSINKX(LHOST,K) + & +CVE(LHOST)*QMCSINKY(LHOST,K) + TMPVEC2(K)=CUN(LHOST)*QMCSINKX(LCHNU,K) + & +CVN(LHOST)*QMCSINKY(LHOST,K) + ENDDO + DO K=1,KC + QMCSOURX(LCHNV,K)=QMCSOURX(LCHNV,K) + & -CI11V*TMPVEC1(K)-CI12V*TMPVEC2(K) + QMCSOURY(LCHNV,K)=QMCSOURY(LCHNV,K) + & -CI21V*TMPVEC1(K)-CI22V*TMPVEC2(K) + ENDDO + ENDIF + ENDIF +C + ENDDO +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,TMPVAL) + DO L=LMPI2,LMPILA + IF(QMCSOURX(L,K).NE.0.0)THEN + TMPVAL=SUB(L)+SUB(L+1) + TMPVAL=MAX(TMPVAL,1.0) + FX(L,K)=FX(L,K)-SUB(L)*QMCSOURX(L,K)/TMPVAL + FX(L+1,K)=FX(L+1,K)-SUB(L+1)*QMCSOURX(L,K)/TMPVAL + ENDIF + IF(QMCSOURY(L,K).NE.0.0)THEN + LN=LNC(L) + TMPVAL=SVB(L)+SVB(LN) + TMPVAL=MAX(TMPVAL,1.0) + FY(L,K)=FY(L,K)-SVB(L)*QMCSOURX(L,K)/TMPVAL + FY(LN,K)=FY(LN,K)-SVB(LN)*QMCSOURX(L,K)/TMPVAL + ENDIF + IF(QMCSINKX(L,K).NE.0.0)THEN + TMPVAL=SUB(L)+SUB(L+1) + TMPVAL=MAX(TMPVAL,1.0) + FX(L,K)=FX(L,K)-SUB(L)*QMCSINKX(L,K)/TMPVAL + FX(L+1,K)=FX(L+1,K)-SUB(L+1)*QMCSINKX(L,K)/TMPVAL + ENDIF + IF(QMCSINKY(L,K).NE.0.0)THEN + LN=LNC(L) + TMPVAL=SVB(L)+SVB(LNC(L)) + TMPVAL=MAX(TMPVAL,1.0) + FY(L,K)=FY(L,K)-SVB(L)*QMCSINKX(L,K)/TMPVAL + FY(LN,K)=FY(LN,K)-SVB(LN)*QMCSINKX(L,K)/TMPVAL + ENDIF + ENDDO + ENDDO +C + ENDIF + MPI_WTIMES(321)=MPI_WTIMES(321)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C +C ** CALCULATE EXPLICIT INTERNAL BUOYANCY FORCINGS CENTERED AT N FOR +C ** THREE TIME LEVEL STEP AND AT (N+1/2) FOR TWO TIME LEVEL STEP +C ** SBX=SBX*0.5*DYU & SBY=SBY*0.5*DXV +C +C----------------------------------------------------------------------C +C +c IINTPG=0 +C +C ORIGINAL +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(B,ic) + CALL broadcast_boundary(BELV,ic) + CALL broadcast_boundary(HP,ic) + MPI_WTIMES(334)=MPI_WTIMES(334)+MPI_TOC(S1TIME) +C + IF(BSC.GT.1.E-6)THEN + + S1TIME=MPI_TIC() + IF(IINTPG.EQ.0)THEN +C + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FBBX(L,K)=SBX(L)*GP*HU(L)* + & ( HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) + & +(B(L,K)-B(L-1,K))*DZC(K) ) + & -(B(L,K+1)-B(L,K)+B(L-1,K+1)-B(L-1,K))* + & (BELV(L)-BELV(L-1)+Z(K)*(HP(L)-HP(L-1))) ) + FBBY(L,K)=SBY(L)*GP*HV(L)* + & ( HV(L)*( (B(L,K+1)-B(LS,K+1))*DZC(K+1) + & +(B(L,K)-B(LS,K))*DZC(K) ) + & -(B(L,K+1)-B(L,K)+B(LS,K+1)-B(LS,K))* + & (BELV(L)-BELV(LS)+Z(K)*(HP(L)-HP(LS))) ) + ENDDO + ENDDO +C + ENDIF + MPI_WTIMES(322)=MPI_WTIMES(322)+MPI_TOC(S1TIME) +C +C *** JACOBIAN +C + IF(IINTPG.EQ.1.)THEN + K=1 + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FBBX(L,K)=SBX(L)*GP*HU(L)* + & ( 0.5*HU(L)*( (B(L,K+2)-B(L-1,K+2))*DZC(K+2) + & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) + & +(B(L,K )-B(L-1,K ))*DZC(K ) + & +(B(L,K )-B(L-1,K ))*DZC(K ) ) + & -0.5*(B(L,K+2)-B(L,K+1)+B(L-1,K+2)-B(L-1,K+1))* + & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) + & -0.5*(B(L,K )-B(L,K )+B(L-1,K )-B(L-1,K ))* + & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) +C + FBBY(L,K)=SBY(L)*GP*HV(L)* + & ( 0.5*HV(L)*( (B(L,K+2)-B(LS ,K+2))*DZC(K+2) + & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) + & +(B(L,K )-B(LS ,K ))*DZC(K ) + & +(B(L,K )-B(LS ,K ))*DZC(K ) ) + & -0.5*(B(L,K+2)-B(L,K+1)+B(LS ,K+2)-B(LS ,K+1))* + & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) + & -0.5*(B(L,K )-B(L,K )+B(LS ,K )-B(LS ,K ))* + & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) + ENDDO + MPI_WTIMES(323)=MPI_WTIMES(323)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(KC.GT.2)THEN + K=KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FBBX(L,K)=SBX(L)*GP*HU(L)* + & ( 0.5*HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) + & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) + & +(B(L,K )-B(L-1,K ))*DZC(K ) + & +(B(L,K-1)-B(L-1,K-1))*DZC(K-1) ) + & -0.5*(B(L,K+1)-B(L,K+1)+B(L-1,K+1)-B(L-1,K+1))* + & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) + & -0.5*(B(L,K )-B(L,K-1)+B(L-1,K )-B(L-1,K-1))* + & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) + FBBY(L,K)=ROLD*FBBY(L,K)+RNEW*SBY(L)*GP*HV(L)* + & ( 0.5*HV(L)*( (B(L,K+1)-B(LS ,K+1))*DZC(K+1) + & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) + & +(B(L,K )-B(LS ,K ))*DZC(K ) + & +(B(L,K-1)-B(LS ,K-1))*DZC(K-1) ) + & -0.5*(B(L,K+1)-B(L,K+1)+B(LS ,K+1)-B(LS ,K+1))* + & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) + & -0.5*(B(L,K )-B(L,K-1)+B(LS ,K )-B(LS ,K-1))* + & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) + ENDDO + ENDIF + MPI_WTIMES(324)=MPI_WTIMES(324)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(KC.GT.3)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FBBX(L,K)=SBX(L)*GP*HU(L)* + & ( 0.5*HU(L)*( (B(L,K+2)-B(L-1,K+2))*DZC(K+2) + & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) + & +(B(L,K )-B(L-1,K ))*DZC(K ) + & +(B(L,K-1)-B(L-1,K-1))*DZC(K-1) ) + & -0.5*(B(L,K+2)-B(L,K+1)+B(L-1,K+2)-B(L-1,K+1))* + & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) + & -0.5*(B(L,K )-B(L,K-1)+B(L-1,K )-B(L-1,K-1))* + & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) + FBBY(L,K)=ROLD*FBBY(L,K)+RNEW*SBY(L)*GP*HV(L)* + & ( 0.5*HV(L)*( (B(L,K+2)-B(LS ,K+2))*DZC(K+2) + & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) + & +(B(L,K )-B(LS ,K ))*DZC(K ) + & +(B(L,K-1)-B(LS ,K-1))*DZC(K-1) ) + & -0.5*(B(L,K+2)-B(L,K+1)+B(LS ,K+2)-B(LS ,K+1))* + & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) + & -0.5*(B(L,K )-B(L,K-1)+B(LS ,K )-B(LS ,K-1))* + & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(325)=MPI_WTIMES(325)+MPI_TOC(S1TIME) +C + ENDIF +C +C FINITE VOLUME +C + IF(IINTPG.EQ.2)THEN +C + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FBBX(L,K)=SBX(L)*GP*HU(L)* + & ( ( HP(L)*B(L,K+1)-HP(L-1)*B(L-1,K+1) )*DZC(K+1) + & +( HP(L)*B(L,K )-HP(L-1)*B(L-1,K ) )*DZC(K ) ) + & -RNEW*SBX(L)*GP*(BELV(L)-BELV(L-1))* + & ( HP(L)*B(L,K+1)-HP(L)*B(L,K) + & +HP(L-1)*B(L-1,K+1)-HP(L-1)*B(L-1,K) ) + & -RNEW*SBX(L)*GP*(HP(L)-HP(L-1))* + & ( HP(L)*ZZ(K+1)*B(L,K+1)-HP(L)*ZZ(K)*B(L,K) + & +HP(L-1)*ZZ(K+1)*B(L-1,K+1)-HP(L-1)*ZZ(K)*B(L-1,K) ) + FBBY(L,K)=SBY(L)*GP*HV(L)* + & ( ( HP(L)*B(L,K+1)-HP(LS )*B(LS ,K+1) )*DZC(K+1) + & +( HP(L)*B(L,K )-HP(LS )*B(LS ,K ) )*DZC(K ) ) + & -RNEW*SBY(L)*GP*(BELV(L)-BELV(LS ))* + & ( HP(L)*B(L,K+1)-HP(L)*B(L,K) + & +HP(LS)*B(LS ,K+1)-HP(LS)*B(LS ,K) ) + & -RNEW*SBY(L)*GP*(HP(L)-HP(LS ))* + & ( HP(L)*ZZ(K+1)*B(L,K+1)-HP(L)*ZZ(K)*B(L,K) + & +HP(LS)*ZZ(K+1)*B(LS ,K+1)-HP(LS)*ZZ(K)*B(LS ,K) ) + ENDDO + ENDDO + MPI_WTIMES(326)=MPI_WTIMES(326)+MPI_TOC(S1TIME) +C + ENDIF + ENDIF ! *** END OF BOUYANCY +C +C IF(N.EQ.1)THEN +C OPEN(1,FILE='BUOY.DIA',STATUS='UNKNOWN') +C DO L=2,LA +C DO K=1,KS +C TMP3D(K)=SUBO(L)*FBBX(L,K) +C ENDDO +C WRITE(1,1111)IL(L),JL(L),(TMP3D(K),K=1,KS) +C DO K=1,KS +C TMP3D(K)=SVBO(L)*FBBY(L,K) +C ENDDO +C WRITE(1,1111)IL(L),JL(L),(TMP3D(K),K=1,KS) +C ENDDO +C CLOSE(1) +C ENDIF +C +C 1111 FORMAT(2I5,2X,8E12.4) +C +C**********************************************************************C +C +C ** CALCULATE EXPLICIT INTERNAL U AND V SHEAR EQUATION TERMS +C +C----------------------------------------------------------------------C +C + S1TIME=MPI_TIC() + IF(KC.GT.1)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + DU(L,KC)=0.0 + DV(L,KC)=0.0 + ENDDO + DO K=1,KS + RCDZF=CDZF(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + !DXYIU(L)=1./(DXU(L)*DYU(L)) + DU(L,K)=RCDZF*( HU(L)*(U(L,K+1)-U(L,K))*DELTI + & +DXYIU(L)*(FCAX(L,K+1)-FCAX(L,K)+FBBX(L,K) + & +SNLT*(FX(L,K)-FX(L,K+1))) ) + DV(L,K)=RCDZF*( HV(L)*(V(L,K+1)-V(L,K))*DELTI + & +DXYIV(L)*(FCAY(L,K)-FCAY(L,K+1)+FBBY(L,K) + & +SNLT*(FY(L,K)-FY(L,K+1))) ) + ELSE + ! *** TEMPORARY VARIABLE, SO MUST BE INITIALIZED + DU(L,K)=0.0 + DV(L,K)=0.0 + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(327)=MPI_WTIMES(327)+MPI_TOC(S1TIME) +C +C IF(ISTL.EQ.2)THEN +C + S1TIME=MPI_TIC() + IF(NWSER.GT.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DU(L,KS)=DU(L,KS)-CDZU(KS)*TSX(L) + DV(L,KS)=DV(L,KS)-CDZU(KS)*TSY(L) + ENDDO + ENDIF + MPI_WTIMES(328)=MPI_WTIMES(328)+MPI_TOC(S1TIME) +C +C ENDIF +C +C**********************************************************************C +C +C IF(N.LE.4)THEN +C CLOSE(1) +C ENDIF +C +C1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) +C +C**********************************************************************C +C + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for new file mode 100644 index 000000000..1d1b3cc6d --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for @@ -0,0 +1,1329 @@ + SUBROUTINE CALFQC_mpi(ISTL_,IS2TL_,MVAR,MO,CON,CON1)!,FQCPAD,QSUMPAD, +! & QSUMNAD) +C +C CHANGE RECORD +C ** SUBROUTINE CALFQC CALCULATES MASS SOURCES AND SINKS ASSOCIATED +C ** WITH CONSTANT AND TIME SERIES INFLOWS AND OUTFLOWS; CONTROL +C ** STRUCTURE INFLOWS AND OUTLOWS; WITHDRAWAL AND RETURN STRUCTURE +C ** OUTFLOWS; AND EMBEDED CHANNEL INFLOWS AND OUTFLOWS +C + USE GLOBAL + USE MPI + + INTEGER::L,K,ID,JD,KD,NWR,IU,JU,KU,LU,NS + INTEGER::LD,NMD,NJP + + DIMENSION CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(LCM,KCM), +! & QSUMNAD(LCM,KCM),QSUMPAD(LCM,KCM) + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ + REAL QVKTMP + REAL QUKTMP + QVKTMP=0.0 + QUKTMP=0.0 + L=0 + IF(.NOT.ALLOCATED(CONQ))THEN + ALLOCATE(CONQ(LCM,KCM)) + CONQ=0.0 + ENDIF +C + M=MO +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'0FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'0FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'0QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'0QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif +C + ! *** SELECTIVE ZEROING + S4TIME=MPI_TIC() + IF(KC.GT.1)THEN + IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FQC(L,1)=0. + ENDDO + ENDIF + + ! *** ZERO EVAP/RAINFALL + IF(MVAR.EQ.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FQC(L,KC)=0. + ENDDO + IF(ISADAC(MVAR).GE.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FQCPAD(L,KC)=0. + ENDDO + ENDIF + IF(ISADAC(MVAR).GT.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + QSUMPAD(L,KC)=0. + ENDDO + ENDIF + ENDIF + + ! *** ZERO ALL DEFINED BC'S +!$OMP PARALLEL DO PRIVATE(L) + DO NS=1,NBCS + L=LBCS(NS) + IF(ISDOMAIN(L))THEN + FQC(L,1:KC)=0. + FQCPAD(L,1:KC)=0 + QSUMPAD(L,1:KC)=0. + ENDIF + ENDDO + + ELSE + FQC=0. + IF(ISADAC(MVAR).GE.2)FQCPAD=0. + QSUMPAD=0. + !QSUMNAD=0. + ENDIF +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'0FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'0FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'0QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'0QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif + + MPI_WTIMES(1101)=MPI_WTIMES(1101)+MPI_TOC(S4TIME) +C + IF(MVAR.EQ.8.AND.IWQPSL.NE.2) GOTO 1500 +C +C ** INITIALIZE VOLUMETRIC SOURCE-SINK FLUXES AND AUXILLARY VARIABLES +C +C + S4TIME=MPI_TIC() + ! *** 3TL STANDARD & WATER QUALITY + IF(ISTL_.EQ.3.OR.MVAR.EQ.8)THEN + IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,1)=CON(L,1) + ENDDO + ENDIF + + ! *** ZERO EVAP/RAINFALL + IF(MVAR.EQ.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,KC)=CON(L,KC) + ENDDO + ENDIF + + ! *** INITIALIZE ALL DEFINED BC'S +!$OMP PARALLEL DO PRIVATE(L) + DO NS=1,NBCS + L=LBCS(NS) + IF(ISDOMAIN(L))THEN + CONQ(L,1:KC)=CON(L,1:KC) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1102)=MPI_WTIMES(1102)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** 3TL CORRECTION STEP + IF(ISTL_.EQ.2.AND.IS2TL_.EQ.0)THEN + IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,1)=0.5*(CON(L,1)+CON1(L,1)) + ENDDO + ENDIF + + ! *** ZERO EVAP/RAINFALL + IF(MVAR.EQ.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,KC)=0.5*(CON(L,KC)+CON1(L,KC)) + ENDDO + ENDIF + + ! *** INITIALIZE ALL DEFINED BC'S +!$OMP PARALLEL DO PRIVATE(L) + DO NS=1,NBCS + L=LBCS(NS) + IF(ISDOMAIN(L))THEN + CONQ(L,1:KC)=0.5*(CON(L,1:KC)+CON1(L,1:KC)) + ENDIF + ENDDO + + ENDIF + + ! *** 2TL STANDARD + IF(ISTL_.EQ.2.AND.IS2TL_.EQ.1)THEN + IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,1)=0.5*(3.*CON(L,1)-CON1(L,1)) + ENDDO + ENDIF + + ! *** ZERO EVAP/RAINFALL + IF(MVAR.EQ.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONQ(L,KC)=0.5*(3.*CON(L,KC)-CON1(L,KC)) + ENDDO + ENDIF + + ! *** INITIALIZE ALL DEFINED BC'S +!$OMP PARALLEL DO PRIVATE(L) + DO NS=1,NBCS + L=LBCS(NS) + IF(ISDOMAIN(L))THEN + CONQ(L,1:KC)=0.5*(3.*CON(L,1:KC)-CON1(L,1:KC)) + ENDIF + ENDDO + + ENDIF + MPI_WTIMES(1103)=MPI_WTIMES(1103)+MPI_TOC(S4TIME) +C + IF(MVAR.EQ.4) GOTO 1000 +C + IF(MVAR.EQ.8)THEN + M=4+NTOX+NSED+NSND+MO + ENDIF +C +C *********************************************************************C +C +C *** STANDARD VOLUMETRICS SOURCE SINK LOCATIONS (2TL) +C + IF(ISTL_.EQ.2.AND.IS2TL_.EQ.1)THEN +C + S4TIME=MPI_TIC() + ! *** FLOW BOUNDARY CELLS (2TL) +CC!$OMP PARALLEL DO PRIVATE(L,NQSTMP,NCSTMP) + DO NS=1,NQSIJ + L=LQS(NS) + NQSTMP=NQSERQ(NS) + NCSTMP=NCSERQ(NS,M) + IF(ISDOMAIN(LQS(NS)))THEN + DO K=1,KC + FQC(L,K)=FQC(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MIN(QSS(K,NS),0.)*CONQ(L,K) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + & +MIN(QSERCELL(K,NS),0.)*CONQ(L,K) + FQCPAD(L,K)=FQCPAD(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +MAX(QSS(K,NS),0.)+MAX(QSERCELL(K,NS),0.) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & +MIN(QSS(K,NS),0.)+MIN(QSERCELL(K,NS),0.) + ENDDO + ENDIF + ENDDO + MPI_WTIMES(1104)=MPI_WTIMES(1104)+MPI_TOC(S4TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'11FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'11FQCD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'11QSUAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'11QSUAD = ', sum(abs(dble(QSUMNAD))) + endif +C + S4TIME=MPI_TIC() + ! *** JET-PLUME VOLUMETRICS SOURCE SINK LOCATIONS (2TL) + IF(NQJPIJ.GT.0)THEN + CALL broadcast_boundary_array(FQC,ic) + DO NJP=1,NQJPIJ + IF(ICALJP(NJP).EQ.1)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + ! *** QVJPTMP=TIME SERIES DISCHARGE FROM JET-PLUME + QVJPTMP=0. + DO K=1,KC + QVJPTMP=QVJPTMP+QSERT(K,NQSERJP(NJP)) + ENDDO + + ! QCJPTMP=ENTRAINMENT FLUX + QCJPTMP=0. + QVJPENT=0. + ! REMOVE ENTRAINMENT FLUX AND CALCULATE TOTAL ENTRAIMENT FLUX + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE JET FLUX AND ENTRAINMENT FLUX IS EFFECTIVE LAYER + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QQCJP(NJP)+RPORTS*QVJPTMP + ENDIF + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + IF(ICALJP(NJP).EQ.2)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + NS=NQWRSERJP(NJP) + LU=LIJ(IUPCJP(NJP),JUPCJP(NJP)) + KU=KUPCJP(NJP) + CONUP=CONQ(LU,KU) + QCJPTMP=0. + QVJPENT=0. + + ! REMOVE ENTRAIMENT FLUX AND CALCULATE TOTAL ENTRAINMENT + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE ENTRAINMENT, CONSTANT AND TIME SERIES FLUXES IN EFFECTIVE CELL + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QWRCJP(NJP)+RPORTS*QWRSERT(NS) + + ! REMOVAL WITHDRAWAL FROM UPSTREAM CELL + FQC(LU,KU)=FQC(LU,KU) + & -RPORTS*QWRCJP(NJP)*CONUP + & -RPORTS*QWRSERT(NS)*CONUP +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -RPORTS*QWRCJP(NJP)-RPORTS*QWRSERT(NS) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1105)=MPI_WTIMES(1105)+MPI_TOC(S4TIME) +C + + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'12FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'12FQD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'12QSAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'12QSAD = ', sum(abs(dble(QSUMNAD))) + endif + + S4TIME=MPI_TIC() + ! *** CONTROL STRUCTURES (2TL) + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) +C!$OMP PARALLEL DO PRIVATE(RQWD,IU,JU,LU,ID,JD,LD) + DO NCTL=1,NQCTL + RQWD=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + RQWD=0. + ELSE + LD=LIJ(ID,JD) + ENDIF + DO K=1,KC + FQC(LU,K)=FQC(LU,K) + & -QCTLT(K,NCTL)*CONQ(LU,K) + FQC(LD,K)=FQC(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + FQCPAD(LD,K)=FQCPAD(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + QSUMPAD(LD,K)=QSUMPAD(LD,K) + & +RQWD*QCTLT(K,NCTL) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & -QCTLT(K,NCTL) + ENDDO + ENDDO + MPI_WTIMES(1106)=MPI_WTIMES(1106)+MPI_TOC(S4TIME) +C + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + S4TIME=MPI_TIC() + ! *** WITHDRAWAL CONCENTRATION RISE RETURN (2TL) + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + NCSTMP=NQWRSERQ(NWR) + FQC(LU,KU)=FQC(LU,KU) + & -(QWR(NWR)+QWRSERT(NQSTMP))*CONQ(LU,KU) + FQC(LD,KD)=FQC(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + FQCPAD(LD,KD)=FQCPAD(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + QSUMPAD(LD,KD)=QSUMPAD(LD,KD) + & +QWR(NWR)+QWRSERT(NQSTMP) +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -(QWR(NWR)+QWRSERT(NQSTMP)) + ENDDO + MPI_WTIMES(1107)=MPI_WTIMES(1107)+MPI_TOC(S4TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + if(myrank.eq.0) print*, n,'13FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'13QSUMPAD= ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'13QSUMNAD= ', sum(abs(dble(QSUMNAD))) + if(myrank.eq.0) print*, n,'13QSUMNAD= ', nqwr,NQCTL + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + if(myrank.eq.0) print*, qsumpad(ld,kd) + enddo + endif +c + S4TIME=MPI_TIC() + ! *** SUBGRID SCALE CHANNEL EXCHANGE (2TL) + IF(MDCHH.GE.1)THEN + DO K=1,KC + DO NMD=1,MDCHH + LMDCHHT=LMDCHH(NMD) + LMDCHUT=LMDCHU(NMD) + LMDCHVT=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QVKTMP=QCHANV(NMD)*DZC(K) + QUKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=QCHANV(NMD)*DZC(K) + ENDIF + FQC(LMDCHHT,K)=FQC(LMDCHHT,K) + & +MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & +MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + & +MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & +MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHUT,K)=FQC(LMDCHUT,K) + & -MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & -MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHVT,K)=FQC(LMDCHVT,K) + & -MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & -MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(1108)=MPI_WTIMES(1108)+MPI_TOC(S4TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'15FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'15FQD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'15QSAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'15QSAD = ', sum(abs(dble(QSUMNAD))) + endif +C + S4TIME=MPI_TIC() + ! *** GROUNDWATER, EVAP, RAINFALL (2TL) + IF(ISGWIE.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDDO + ENDIF + MPI_WTIMES(1109)=MPI_WTIMES(1109)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** ZONED SEEPAGE (2TL) + IF(ISGWIT.EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(H1P(L).GT.HDRY)THEN + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1110)=MPI_WTIMES(1110)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** TEMPERATURE ADJUSTMENTS FOR RAINFALL & EVAPORATION + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0.OR.ISTOPT(2).EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TEMO*DXYP(L) + ENDDO + ENDIF + IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.2.OR.ISTOPT(2).EQ.4)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + FQCPAD(L,KC)=FQCPAD(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + QSUMPAD(L,KC)=QSUMPAD(L,KC)+RAINT(L)*DXYP(L) + ENDDO + ENDIF + ENDIF + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)-EVAPSW(L)*CONQ(L,KC) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(1111)=MPI_WTIMES(1111)+MPI_TOC(S4TIME) + ENDIF +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + call collect_in_zero_array(FQC ) + if(myrank.eq.0) print*, n,'2FQC = ', sum(abs(dble(FQC ))) + if(myrank.eq.0) print*, n,'2FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'2QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'2QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif + +C *********************************************************************C +C +C *** 3TL CORRECTOR VOLUMETRICS SOURCE SINK LOCATIONS +C + IF(ISTL_.EQ.2.AND.IS2TL_.EQ.0)THEN +C + S4TIME=MPI_TIC() + ! *** FLOW BOUNDARY CELLS (3TL CORRECTOR) + DO NS=1,NQSIJ + L=LQS(NS) + NQSTMP=NQSERQ(NS) + NCSTMP=NCSERQ(NS,M) + IF(ISDOMAIN(LQS(NS)))THEN + DO K=1,KC + FQC(L,K)=FQC(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MIN(QSS(K,NS),0.)*CONQ(L,K) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + & +MIN(QSERCELL(K,NS),0.)*CONQ(L,K) + FQCPAD(L,K)=FQCPAD(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +MAX(QSS(K,NS),0.)+MAX(QSERCELL(K,NS),0.) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & +MIN(QSS(K,NS),0.)+MIN(QSERCELL(K,NS),0.) + ENDDO + ENDIF + ENDDO + MPI_WTIMES(1112)=MPI_WTIMES(1112)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + ! *** JET-PLUME VOLUMETRICS SOURCE SINK LOCATIONS (3TL CORRECTOR) + IF(NQJPIJ.GT.0)THEN + DO NJP=1,NQJPIJ + IF(ICALJP(NJP).EQ.1)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + + ! QVJPTMP=TIME SERIES DISCHARGE FROM JET-PLUME + QVJPTMP=0. + DO K=1,KC + QVJPTMP=QVJPTMP+QSERT(K,NQSERJP(NJP)) + ENDDO + + ! QCJPTMP=ENTRAINMENT FLUX + QCJPTMP=0. + QVJPENT=0. + + ! REMOVE ENTRAINMENT FLUX AND CALCULATE TOTAL ENTRAIMENT FLUX + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE JET FLUX AND ENTRAINMENT FLUX IS EFFECTIVE LAYER + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QQCJP(NJP)+RPORTS*QVJPTMP + ENDIF + IF(ICALJP(NJP).EQ.2)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + NS=NQWRSERJP(NJP) + LU=LIJ(IUPCJP(NJP),JUPCJP(NJP)) + KU=KUPCJP(NJP) + CONUP=CONQ(LU,KU) + QCJPTMP=0. + QVJPENT=0. + + ! REMOVE ENTRAIMENT FLUX AND CALCULATE TOTAL ENTRAINMENT + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE ENTRAINMENT, CONSTANT AND TIME SERIES FLUXES IN EFFECTIVE CELL + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QWRCJP(NJP)+RPORTS*QWRSERT(NS) + + ! REMOVAL WITHDRAWAL FROM UPSTREAM CELL + FQC(LU,KU)=FQC(LU,KU) + & -RPORTS*QWRCJP(NJP)*CONUP + & -RPORTS*QWRSERT(NS)*CONUP +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -RPORTS*QWRCJP(NJP)-RPORTS*QWRSERT(NS) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1113)=MPI_WTIMES(1113)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + ! *** CONTROL STRUCTURES (3TL CORRECTOR) + DO NCTL=1,NQCTL + RQWD=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + RQWD=0. + ELSE + LD=LIJ(ID,JD) + ENDIF + DO K=1,KC + FQC(LU,K)=FQC(LU,K) + & -QCTLT(K,NCTL)*CONQ(LU,K) + FQC(LD,K)=FQC(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + FQCPAD(LD,K)=FQCPAD(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +RQWD*QCTLT(K,NCTL) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & -QCTLT(K,NCTL) + ENDDO + ENDDO + MPI_WTIMES(1114)=MPI_WTIMES(1114)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + CALL broadcast_boundary_array(CONQ,ic) + CALL broadcast_boundary_array(FQC,ic) + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + ! *** WITHDRAWAL CONCENTRATION RISE RETURN (3TL CORRECTOR) + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + NCSTMP=NQWRSERQ(NWR) + FQC(LU,KU)=FQC(LU,KU) + & -(QWR(NWR)+QWRSERT(NQSTMP))*CONQ(LU,KU) + FQC(LD,KD)=FQC(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + FQCPAD(LD,KD)=FQCPAD(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + QSUMPAD(LD,KD)=QSUMPAD(LD,KD) + & +QWR(NWR)+QWRSERT(NQSTMP) +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -(QWR(NWR)+QWRSERT(NQSTMP)) + ENDDO + MPI_WTIMES(1115)=MPI_WTIMES(1115)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** SUBGRID SCALE CHANNEL EXCHANGE (3TL CORRECTOR) + IF(MDCHH.GE.1)THEN + DO K=1,KC + DO NMD=1,MDCHH + LMDCHHT=LMDCHH(NMD) + LMDCHUT=LMDCHU(NMD) + LMDCHVT=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QVKTMP=QCHANV(NMD)*DZC(K) + QUKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=QCHANV(NMD)*DZC(K) + ENDIF + FQC(LMDCHHT,K)=FQC(LMDCHHT,K) + & +MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & +MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + & +MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & +MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHUT,K)=FQC(LMDCHUT,K) + & -MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & -MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHVT,K)=FQC(LMDCHVT,K) + & -MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & -MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(1116)=MPI_WTIMES(1116)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** GROUNDWATER, EVAP, RAINFALL (3TL CORRECTOR) + IF(ISGWIE.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDDO + ENDIF + MPI_WTIMES(1117)=MPI_WTIMES(1117)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** ZONED SEEPAGE (3TL) + IF(ISGWIT.EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(H1P(L).GT.HDRY)THEN + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1118)=MPI_WTIMES(1118)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** TEMPERATURE ADJUSTMENTS FOR RAINFALL & EVAPORATION + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0.OR.ISTOPT(2).EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TEMO*DXYP(L) + ENDDO + ENDIF + IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.2.OR.ISTOPT(2).EQ.4)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + FQCPAD(L,KC)=FQCPAD(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + QSUMPAD(L,KC)=QSUMPAD(L,KC)+RAINT(L)*DXYP(L) + ENDDO + ENDIF + ENDIF + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)-EVAPSW(L)*CONQ(L,KC) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(1119)=MPI_WTIMES(1119)+MPI_TOC(S4TIME) +C + ENDIF + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + if(myrank.eq.0) print*, n,'3FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'3QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'3QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif + +C *********************************************************************C +C +C ** STANDARD VOLUMETRICS SOURCE SINK LOCATIONS (3TL) +C + IF(ISTL_.EQ.3)THEN +C + S4TIME=MPI_TIC() + ! *** FLOW BOUNDARY CELLS (3TL) + DO NS=1,NQSIJ + L=LQS(NS) + NQSTMP=NQSERQ(NS) + NCSTMP=NCSERQ(NS,M) + IF(ISDOMAIN(LQS(NS)))THEN + DO K=1,KC + FQC(L,K)=FQC(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MIN(QSS(K,NS),0.)*CONQ(L,K) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + & +MIN(QSERCELL(K,NS),0.)*CONQ(L,K) + FQCPAD(L,K)=FQCPAD(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +MAX(QSS(K,NS),0.)+MAX(QSERCELL(K,NS),0.) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & +MIN(QSS(K,NS),0.)+MIN(QSERCELL(K,NS),0.) + ENDDO + ENDIF + ENDDO + MPI_WTIMES(1120)=MPI_WTIMES(1120)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** JET-PLUME VOLUMETRICS SOURCE SINK LOCATIONS (3TL) + IF(NQJPIJ.GT.0)THEN + DO NJP=1,NQJPIJ + IF(ICALJP(NJP).EQ.1)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + + ! QVJPTMP=TIME SERIES DISCHARGE FROM JET-PLUME + QVJPTMP=0. + DO K=1,KC + QVJPTMP=QVJPTMP+QSERT(K,NQSERJP(NJP)) + ENDDO + + ! QCJPTMP=ENTRAINMENT FLUX + QCJPTMP=0. + QVJPENT=0. + + ! REMOVE ENTRAINMENT FLUX AND CALCULATE TOTAL ENTRAIMENT FLUX + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE JET FLUX AND ENTRAINMENT FLUX IS EFFECTIVE LAYER + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QQCJP(NJP)*CQCJP(1,NJP,M) + & +RPORTS*QVJPTMP*CSERT(1,NCSERJP(NJP,M),M) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QQCJP(NJP)+RPORTS*QVJPTMP + ENDIF + IF(ICALJP(NJP).EQ.2)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) + NS=NQWRSERJP(NJP) + LU=LIJ(IUPCJP(NJP),JUPCJP(NJP)) + KU=KUPCJP(NJP) + CONUP=CONQ(LU,KU) + QCJPTMP=0. + QVJPENT=0. + + ! REMOVE ENTRAIMENT FLUX AND CALCULATE TOTAL ENTRAINMENT + DO K=1,KC + FQC(LJP,K)=FQC(LJP,K)-RPORTS*QJPENT(K,NJP)*CONQ(LJP,K) + QCJPTMP=QCJPTMP+QJPENT(K,NJP)*CONQ(LJP,K) + QVJPENT=QVJPENT+QJPENT(K,NJP) +C QSUMNAD(LJP,K)=QSUMNAD(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO + + ! PLACE ENTRAINMENT, CONSTANT AND TIME SERIES FLUXES IN EFFECTIVE CELL + FQC(LJP,KTMP)=FQC(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + FQCPAD(LJP,KTMP)=FQCPAD(LJP,KTMP)+RPORTS*QCJPTMP + & +RPORTS*QWRCJP(NJP)*(CWRCJP(NJP,M)+CONUP) + & +RPORTS*QWRSERT(NS)*(CQWRSERT(NS,M)+CONUP) + QSUMPAD(LJP,KTMP)=QSUMPAD(LJP,KTMP)+RPORTS*QVJPENT + & +RPORTS*QWRCJP(NJP)+RPORTS*QWRSERT(NS) + + ! REMOVAL WITHDRAWAL FROM UPSTREAM CELL + FQC(LU,KU)=FQC(LU,KU) + & -RPORTS*QWRCJP(NJP)*CONUP + & -RPORTS*QWRSERT(NS)*CONUP +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -RPORTS*QWRCJP(NJP)-RPORTS*QWRSERT(NS) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1121)=MPI_WTIMES(1121)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** CONTROL STRUCTURES (3TL) + DO NCTL=1,NQCTL + RQWD=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + RQWD=0. + ELSE + LD=LIJ(ID,JD) + ENDIF + DO K=1,KC + FQC(LU,K)=FQC(LU,K) + & -QCTLT(K,NCTL)*CONQ(LU,K) + FQC(LD,K)=FQC(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + FQCPAD(LD,K)=FQCPAD(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +RQWD*QCTLT(K,NCTL) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & -QCTLT(K,NCTL) + ENDDO + ENDDO + MPI_WTIMES(1122)=MPI_WTIMES(1122)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** WITHDRAWAL CONCENTRATION RISE RETURN (3TL) + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + NCSTMP=NQWRSERQ(NWR) + FQC(LU,KU)=FQC(LU,KU) + & -(QWR(NWR)+QWRSERT(NQSTMP))*CONQ(LU,KU) + FQC(LD,KD)=FQC(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + FQCPAD(LD,KD)=FQCPAD(LD,KD) + & +QWR(NWR)*(CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CONQ(LU,KU)+CQWRSERT(NCSTMP,M)) + QSUMPAD(LD,KD)=QSUMPAD(LD,KD) + & +QWR(NWR)+QWRSERT(NQSTMP) +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -(QWR(NWR)+QWRSERT(NQSTMP)) + ENDDO + MPI_WTIMES(1123)=MPI_WTIMES(1123)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** SUBGRID SCALE CHANNEL EXCHANGE (3TL) + IF(MDCHH.GE.1)THEN + DO K=1,KC + DO NMD=1,MDCHH + LMDCHHT=LMDCHH(NMD) + LMDCHUT=LMDCHU(NMD) + LMDCHVT=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QVKTMP=QCHANV(NMD)*DZC(K) + QUKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=QCHANV(NMD)*DZC(K) + ENDIF + FQC(LMDCHHT,K)=FQC(LMDCHHT,K) + & +MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & +MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + & +MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & +MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHUT,K)=FQC(LMDCHUT,K) + & -MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & -MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHVT,K)=FQC(LMDCHVT,K) + & -MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & -MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(1124)=MPI_WTIMES(1124)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** GROUNDWATER, EVAP, RAINFALL (3TL) + IF(ISGWIE.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDDO + ENDIF + MPI_WTIMES(1125)=MPI_WTIMES(1125)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** ZONED SEEPAGE (3TL) + IF(ISGWIT.EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(H1P(L).GT.HDRY)THEN + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1126)=MPI_WTIMES(1126)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** TEMPERATURE ADJUSTMENTS FOR RAINFALL & EVAPORATION + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0.OR.ISTOPT(2).EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TEMO*DXYP(L) + ENDDO + ENDIF + IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.2.OR.ISTOPT(2).EQ.4)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + FQCPAD(L,KC)=FQCPAD(L,KC)+RAINT(L)*TATMT(L)*DXYP(L) + QSUMPAD(L,KC)=QSUMPAD(L,KC)+RAINT(L)*DXYP(L) + ENDDO + ENDIF + ENDIF + IF(M.EQ.2)THEN + IF(ISTOPT(2).EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,KC)=FQC(L,KC)-EVAPSW(L)*CONQ(L,KC) + ENDDO + ENDIF + ENDIF + ENDIF + MPI_WTIMES(1127)=MPI_WTIMES(1127)+MPI_TOC(S4TIME) +C + GOTO 2000 +C +C *** SHELL FISH LARVAE SECTION +C + 1000 CONTINUE +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + if(myrank.eq.0) print*, n,'4FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'4QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'4QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif + + S4TIME=MPI_TIC() + DO NS=1,NQSIJ + L=LQS(NS) + NQSTMP=NQSERQ(NS) + NCSTMP=NCSERQ(NS,M) + IF(ISDOMAIN(LQS(NS)))THEN + DO K=1,KC + FQC(L,K)=FQC(L,K) + & +MAX(QSS(K,NS),0.)*CQS(K,NS,M) + & +MIN(QSS(K,NS),0.)*CONQ(L,K) + & +MAX(QSERCELL(K,NS),0.)*CSERT(K,NCSTMP,M) + & +MIN(QSERCELL(K,NS),0.)*CONQ(L,K) + ENDDO + ENDIF + ENDDO + MPI_WTIMES(1128)=MPI_WTIMES(1128)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + DO NCTL=1,NQCTL + RQWD=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + RQWD=0. + ELSE + LD=LIJ(ID,JD) + ENDIF + DO K=1,KC + FQC(LU,K)=FQC(LU,K) + & -QCTLT(K,NCTL)*CONQ(LU,K) + FQC(LD,K)=FQC(LD,K) + & +RQWD*QCTLT(K,NCTL)*CONQ(LU,K) + ENDDO + ENDDO + MPI_WTIMES(1129)=MPI_WTIMES(1129)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + NCSTMP=NQWRSERQ(NWR) + FQC(LU,KU)=FQC(LU,KU) + & -(QWR(NWR)+QWRSERT(NQSTMP))*CONQ(LU,KU) + FQC(LD,KD)=FQC(LD,KD) + & +QWR(NWR)*(SFLKILL*CONQ(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(SFLKILL*CONQ(LU,KU) + & +CQWRSERT(NCSTMP,M)) + ENDDO + MPI_WTIMES(1130)=MPI_WTIMES(1130)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + IF(MDCHH.GE.1)THEN + DO K=1,KC + DO NMD=1,MDCHH + LMDCHHT=LMDCHH(NMD) + LMDCHUT=LMDCHU(NMD) + LMDCHVT=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QVKTMP=QCHANV(NMD)*DZC(K) + QUKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=QCHANV(NMD)*DZC(K) + ENDIF + FQC(LMDCHHT,K)=FQC(LMDCHHT,K) + & +MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & +MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + & +MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & +MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHUT,K)=FQC(LMDCHUT,K) + & -MAX(QUKTMP,0.)*CONQ(LMDCHUT,K) + & -MIN(QUKTMP,0.)*CONQ(LMDCHHT,K) + FQC(LMDCHVT,K)=FQC(LMDCHVT,K) + & -MAX(QVKTMP,0.)*CONQ(LMDCHVT,K) + & -MIN(QVKTMP,0.)*CONQ(LMDCHHT,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(1131)=MPI_WTIMES(1131)+MPI_TOC(S4TIME) +C + GOTO 2000 +C +C *** WATER QUALITY ONLY (IWQPSL=1,0) +C + 1500 CONTINUE +C + S4TIME=MPI_TIC() + ! *** FLOW BOUNDARIES + DO NS=1,NQSIJ + L=LQS(NS) + NQSTMP=NQSERQ(NS) + DO K=1,KC + FQC(L,K)=FQC(L,K) + & +MIN(QSS(K,NS),0.)*CON1(L,K) + & +MIN(QSERCELL(K,NS),0.)*CON1(L,K) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +MAX(QSS(K,NS),0.)+MAX(QSERCELL(K,NS),0.) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & +MIN(QSS(K,NS),0.)+MIN(QSERCELL(K,NS),0.) + ENDDO + ENDDO + MPI_WTIMES(1132)=MPI_WTIMES(1132)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** HYDRAULIC STRUCTURES + DO NCTL=1,NQCTL + RQWD=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + RQWD=0. + ELSE + LD=LIJ(ID,JD) + ENDIF + DO K=1,KC + FQC(LU,K)=FQC(LU,K) + & -QCTLT(K,NCTL)*CON1(LU,K) + FQC(LD,K)=FQC(LD,K) + & +RQWD*QCTLT(K,NCTL)*CON1(LU,K) + FQCPAD(LD,K)=FQCPAD(LD,K) + & +RQWD*QCTLT(K,NCTL)*CON1(LU,K) + QSUMPAD(L,K)=QSUMPAD(L,K) + & +RQWD*QCTLT(K,NCTL) +C QSUMNAD(L,K)=QSUMNAD(L,K) +C & -QCTLT(K,NCTL) + ENDDO + ENDDO + MPI_WTIMES(1133)=MPI_WTIMES(1133)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** WITHDRAWAL/RETURN + IF(MVAR.EQ.8)THEN + M=4+NTOX+NSED+NSND+MO + ELSE + M=MO + ENDIF + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + NCSTMP=NQWRSERQ(NWR) + FQC(LU,KU)=FQC(LU,KU) + & -(QWR(NWR)+QWRSERT(NQSTMP))*CON1(LU,KU) + FQC(LD,KD)=FQC(LD,KD) + & +QWR(NWR)*(CON1(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CON1(LU,KU)+CQWRSERT(NCSTMP,M)) + FQCPAD(LD,KD)=FQCPAD(LD,KD) + & +QWR(NWR)*(CON1(LU,KU)+CQWR(NWR,M)) + & +QWRSERT(NQSTMP)*(CON1(LU,KU)+CQWRSERT(NCSTMP,M)) + QSUMPAD(LD,KD)=QSUMPAD(LD,KD) + & +QWR(NWR)+QWRSERT(NQSTMP) +C QSUMNAD(LU,KU)=QSUMNAD(LU,KU) +C & -(QWR(NWR)+QWRSERT(NQSTMP)) + ENDDO + MPI_WTIMES(1134)=MPI_WTIMES(1134)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** SUBGRID CHANNEL INTERACTIONS + IF(MDCHH.GE.1)THEN + DO K=1,KC + DO NMD=1,MDCHH + LMDCHHT=LMDCHH(NMD) + LMDCHUT=LMDCHU(NMD) + LMDCHVT=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QVKTMP=QCHANV(NMD)*DZC(K) + QUKTMP=0. + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + QUKTMP=QCHANU(NMD)*DZC(K) + QVKTMP=QCHANV(NMD)*DZC(K) + ENDIF + FQC(LMDCHHT,K)=FQC(LMDCHHT,K) + & +MAX(QUKTMP,0.)*CON1(LMDCHUT,K) + & +MIN(QUKTMP,0.)*CON1(LMDCHHT,K) + & +MAX(QVKTMP,0.)*CON1(LMDCHVT,K) + & +MIN(QVKTMP,0.)*CON1(LMDCHHT,K) + FQC(LMDCHUT,K)=FQC(LMDCHUT,K) + & -MAX(QUKTMP,0.)*CON1(LMDCHUT,K) + & -MIN(QUKTMP,0.)*CON1(LMDCHHT,K) + FQC(LMDCHVT,K)=FQC(LMDCHVT,K) + & -MAX(QVKTMP,0.)*CON1(LMDCHVT,K) + & -MIN(QVKTMP,0.)*CON1(LMDCHHT,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(1135)=MPI_WTIMES(1135)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** GROUNDWATER, EVAP, RAINFALL (2TL) + IF(ISGWIE.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FQC(L,1)=FQC(L,1)-RIFTR(L)*CONQ(L,1) + ENDDO + ENDIF + MPI_WTIMES(1136)=MPI_WTIMES(1136)+MPI_TOC(S4TIME) +C + S4TIME=MPI_TIC() + ! *** ZONED SEEPAGE (2TL) + IF(ISGWIT.EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(H1P(L).GT.HDRY)THEN + FQC(L,1)=FQC(L,1)-RIFTR(L)*CON1(L,1) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1137)=MPI_WTIMES(1137)+MPI_TOC(S4TIME) +C + 2000 CONTINUE + + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FQCPAD ) + call collect_in_zero_array(QSUMPAD ) + call collect_in_zero_array(QSUMNAD ) + if(myrank.eq.0) print*, n,'5FQCPAD = ', sum(abs(dble(FQCPAD ))) + if(myrank.eq.0) print*, n,'5QSUMPAD = ', sum(abs(dble(QSUMPAD))) + if(myrank.eq.0) print*, n,'5QSUMNAD = ', sum(abs(dble(QSUMNAD))) + endif + + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF_mpi.for new file mode 100644 index 000000000..aa195cf31 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHDMF_mpi.for @@ -0,0 +1,342 @@ + SUBROUTINE CALHDMF_mpi +C +C *** CALDMF CALCULATES THE HORIZONTAL VISCOSITY AND +C *** DIFFUSIVE MOMENTUM FLUXES. THE VISCOSITY, AH IS CALCULATED USING +C *** SMAGORINSKY'S SUBGRID SCALE FORMULATION PLUS A CONSTANT AHO +C +C *** ONLY VALID FOR ISHDMF.GE.1 +C +C CHANGE RECORD +C REWRITTEN BY PAUL M. CRAIG NOV/DEC 2004 +C 2008-10 SANG YUK (DSLLC) CORRECTED THE DIFFUSIVE MOMENTUM FLUXES COMPUTATION +C + USE GLOBAL + USE MPI + IMPLICIT NONE + INTEGER::L,LN,LS,LW,K,LL,J,I + REAL::SLIPCO,DY2DZBR,DX2DZBR,CSDRAG,SLIPFAC,TMPVAL,DSQR,WVFACT + REAL::DTMPH,DTMPX,AHWVX,SXYLN,SXYEE + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::AHEE + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::AHNN + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SXY + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SXY2CC + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SXY2EE + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::SXY2NN + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::HMC + IF(.NOT.ALLOCATED(AHEE))THEN + ALLOCATE(AHEE(LCM,KCM)) + ALLOCATE(AHNN(LCM,KCM)) + ALLOCATE(SXY(LCM,KCM)) + ALLOCATE(SXY2CC(LCM,KCM)) + ALLOCATE(SXY2EE(LCM,KCM)) + ALLOCATE(SXY2NN(LCM,KCM)) + ALLOCATE(HMC(LCM)) + AHEE=0.0 + AHNN=0.0 + SXY=0.0 + SXY2CC=0.0 + SXY2EE=0.0 + SXY2NN=0.0 + HMC=0.0 + ENDIF + SLIPCO=0.0 +C + AHMAX=AHO +C +C ** CALCUATE TYPE FLAGS +C + S1TIME=MPI_TIC() + IF(ISDRY.GE.1.OR.N.LT.5)THEN + ! *** ICORDYU +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + IF(SUB(L).LT.0.5.AND.SUB(LS).LT.0.5) ICORDYU(L)=0 + IF(SUB(L).GT.0.5.AND.SUB(LS).GT.0.5) ICORDYU(L)=1 + IF(SUB(L).LT.0.5.AND.SUB(LS).GT.0.5) ICORDYU(L)=2 + IF(SUB(L).GT.0.5.AND.SUB(LS).LT.0.5) ICORDYU(L)=3 + ENDDO + ! *** ICORDXV +!$OMP PARALLEL DO PRIVATE(LW) + DO L=LMPI2,LMPILA + LW=L-1 + IF(SVB(L).LT.0.5.AND.SVB(LW).LT.0.5) ICORDXV(L)=0 + IF(SVB(L).GT.0.5.AND.SVB(LW).GT.0.5)THEN + ICORDXV(L)=1 + IF(SUB(L).LT.0.5) ICORDXV(L)=3 + ENDIF + IF(SVB(L).LT.0.5.AND.SVB(LW).GT.0.5) ICORDXV(L)=2 + IF(SVB(L).GT.0.5.AND.SVB(LW).LT.0.5) ICORDXV(L)=3 + ENDDO + ENDIF + MPI_WTIMES(401)=MPI_WTIMES(401)+MPI_TOC(S1TIME) +C +C ** CALCULATE HORIZONTAL VELOCITY SHEARS +C + ! *** SXX+SYY DEFINED AT CELL CENTERS AND STORED IN DXU1(L,K) + S1TIME=MPI_TIC() + IF(AHD.GT.0.0)THEN + SLIPCO=0.5/SQRT(AHD) + ENDIF + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + ! *** DXU1 = dU/dX, UNITS: 1/S + DXU1(L,K)=SUB(L+1)*(U(L+1,K)-U(L,K))/DXP(L) + ! *** DYV1 = dV/dY, UNITS: 1/S + DYV1(L,K)=SVB(LN )*(V(LN,K)-V(L,K))/DYP(L) + ENDDO + ENDDO + MPI_WTIMES(402)=MPI_WTIMES(402)+MPI_TOC(S1TIME) +C + ! *** DYU1 = dU/dY + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS,DY2DZBR,CSDRAG,SLIPFAC) + DO L=LMPI2,LMPILA + LS=LSC(L) + IF(ICORDYU(L).EQ.1)THEN + DYU1(L,K)=2.*SVB(L)*(U(L,K)-U(LS,K))/(DYU(L)+DYU(LS)) + ELSE + DYU1(L,K)=0. + ENDIF + IF(ISHDMF.EQ.2)THEN + ! *** HMD WITH WALL EFFECTS + IF(ICORDYU(L).EQ.2)THEN + DY2DZBR=1.+0.5*DYU(LS)/ZBRWALL + CSDRAG=0.16/((LOG(DY2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + DYU1(L,K)=-2.*SLIPFAC*U(LS,K)/DYU(LS) + ENDIF + IF(ICORDYU(L).EQ.3)THEN + DY2DZBR=1.+0.5*DYU(L)/ZBRWALL + CSDRAG=0.16/((LOG(DY2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + DYU1(L,K)=2.*SLIPFAC*U(L,K)/DYU(L) + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(403)=MPI_WTIMES(403)+MPI_TOC(S1TIME) +C + ! *** DXV1 = dV/dX + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LW,DX2DZBR,CSDRAG,SLIPFAC) + DO L=LMPI2,LMPILA + LW=L-1 + IF(ICORDXV(L).EQ.1)THEN + DXV1(L,K)=2.*SUB(L)*(V(L,K)-V(LW,K))/(DXV(L)+DXV(LW)) + ELSE + DXV1(L,K)=0. + ENDIF + IF(ISHDMF.EQ.2)THEN + ! *** WALL EFFECTS + IF(ICORDXV(L).EQ.2)THEN + DX2DZBR=1.+0.5*DXV(LW)/ZBRWALL + CSDRAG=0.16/((LOG(DX2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + DXV1(L,K)=-2.*SLIPFAC*V(LW,K)/DXV(LW) + ENDIF + IF(ICORDXV(L).EQ.3)THEN + DX2DZBR=1.+0.5*DXV(L)/ZBRWALL + CSDRAG=0.16/((LOG(DX2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + DXV1(L,K)=2.*SLIPFAC*V(L,K)/DXV(L) + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(404)=MPI_WTIMES(404)+MPI_TOC(S1TIME) +C + ! *** SXY = dU/dY + dV/dX + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SXY(L,K)=DYU1(L,K)+DXV1(L,K) + ENDDO + ENDDO + MPI_WTIMES(405)=MPI_WTIMES(405)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(AHD.GT.0.0)THEN + ! *** CALCULATE SMAGORINSKY HORIZONTAL VISCOSITY + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(TMPVAL,DSQR) + DO L=LMPI2,LMPILA + TMPVAL=AHD*DXP(L)*DYP(L) + DSQR=DXU1(L,K)*DXU1(L,K)+DYV1(L,K)*DYV1(L,K)+ + & SXY(L,K)*SXY(L,K)/4 + AH(L,K)=AHO+TMPVAL*SQRT(DSQR) + ENDDO + ENDDO + ELSEIF(N.LT.10)THEN + ! *** ONLY NEED TO ASSIGN INITIALLY + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AH(L,K)=AHO + ENDDO + ENDDO + ENDIF + MPI_WTIMES(406)=MPI_WTIMES(406)+MPI_TOC(S1TIME) +C +C *** DSLLC BEGIN BLOCK +C ** CALCULATE HORIZONTAL DIFFUSION DUE TO WAVE BREAKING +C + S1TIME=MPI_TIC() + IF(ISWAVE.EQ.2)THEN + IF(WVLSH.GT.0.0.OR.WVLSX.GT.0.0)THEN + IF(N.LT.NTSWV)THEN + TMPVAL=FLOAT(N)/FLOAT(NTSWV) + WVFACT=0.5-0.5*COS(PI*TMPVAL) + ELSE + WVFACT=1.0 + ENDIF + AHWVX=WVLSX*WVPRD*WVPRD + IF(ISDRY.GT.0)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(DTMPH,DTMPX) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + DTMPH=WVDISP(L,K)**0.3333 + DTMPX=WVDISP(L,K)/HP(L) ! *** PMC HMP-->HP + AH(L,K)=AH(L,K)+WVFACT*(WVLSH*DTMPH*HP(L) + & +AHWVX*DTMPX) + ENDIF + ENDDO + ENDDO + ELSE + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(DTMPH,DTMPX) + DO L=LMPI2,LMPILA + DTMPH=WVDISP(L,K)**0.3333 + DTMPX=WVDISP(L,K)/HP(L) ! *** PMC HMP-->HP + AH(L,K)=AH(L,K)+WVFACT*(WVLSH*DTMPH*HP(L)+AHWVX*DTMPX) + ENDDO + ENDDO + ENDIF + ENDIF + ENDIF + MPI_WTIMES(407)=MPI_WTIMES(407)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + MPI_WTIMES(416)=MPI_WTIMES(416)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(DXU1,ic) + MPI_WTIMES(412)=MPI_WTIMES(412)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(DYV1,ic) + MPI_WTIMES(413)=MPI_WTIMES(413)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(SXY,ic) + MPI_WTIMES(414)=MPI_WTIMES(414)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(AH,ic) + MPI_WTIMES(415)=MPI_WTIMES(415)+MPI_TOC(S1TIME) +C +C *** DSLLC END BLOCK +C + IF(N.EQ.2.AND.ISLOG.GT.0.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='AHDIFF.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='AHDIFF.DIA') + DO L=2,LA + WRITE(1,1112)IL(L),JL(L),AH(L,KC) + ENDDO + CLOSE(1) + ENDIF +C +C ** CALCULATE DIFFUSIVE MOMENTUM FLUXES +C + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS,LN) + DO L=LMPI2,LMPILA + LS=LSC(L) + LN=LNC(L) + ! SANG'S CORRECTION + FMDUX(L,K)=2.0*SUB(L)* + & (HP(L)*AH(L,K)*DXU1(L,K)*DYP(L)- + & HP(L-1)*AH(L-1,K)*DXU1(L-1,K)*DYP(L-1)) + + FMDUY(L,K)=SVB(LN)* + & (DXU(LN)*HU(LN)*AH(LN,K)*SXY(LN,K)- + & DXU(l)*HU(L)*AH(L,K)*SXY(L,K)) + + FMDVY(L,K)=2.0*SVB(L)* + & (DXP(L)*HP(L)*AH(L,K)*DYV1(L,K)- + & DXP(LS)*HP(LS)*AH(LS,K)*DYV1(LS,K)) + + FMDVX(L,K)=SUB(L+1)* + & (DYV(L+1)*HV(L+1)*AH(L+1,K)*SXY(L+1,K)- + & DYV(L)*HV(L)*AH(L,K)*SXY(L,K)) + + ENDDO + ENDDO + MPI_WTIMES(408)=MPI_WTIMES(408)+MPI_TOC(S1TIME) +C + ! *** TREAT THE NORTH & WEST WALL SLIPPAGE + S1TIME=MPI_TIC() + IF(ISHDMF.EQ.2)THEN +!$OMP PARALLEL DO PRIVATE(LN,DY2DZBR,CSDRAG,SLIPFAC,SXYLN,DX2DZBR,SXYEE) + DO L=LMPI2,LMPILA + LN=LNC(L) + IF(SVBO(LN).LT.0.5)THEN + DO K=1,KC + DY2DZBR=1.+0.5*DYU(L)/ZBRWALL + CSDRAG=0.16/((LOG(DY2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + SXYLN=-2.*SLIPFAC*U(L,K)/DYU(L) + FMDUY(L,K)=DXU(L)*HP(L)*AH(L,K)*(SXYLN-SXY(L ,K)) + ENDDO + ENDIF + IF(SUBO(L+1).LT.0.5)THEN + DO K=1,KC + DX2DZBR=1.+0.5*DXV(L)/ZBRWALL + CSDRAG=0.16/((LOG(DX2DZBR))**2) + SLIPFAC=SLIPCO*SQRT(CSDRAG) + SXYEE=-2.*SLIPFAC*V(L,K)/DXV(L) + FMDVX(L,K)=DYV(L)*HP(L)*AH(L,K)*(SXYEE-SXY(L,K)) + ENDDO + ENDIF + ENDDO + ENDIF + MPI_WTIMES(409)=MPI_WTIMES(409)+MPI_TOC(S1TIME) + + ! *** ZERO BOUNDARY CELL MOMENTUM DIFFUSION + S1TIME=MPI_TIC() + DO LL=1,NBCS + L=LBCS(LL) + DO K=1,KC + FMDUX(L,K)=0.0 + FMDUY(L,K)=0.0 + FMDVY(L,K)=0.0 + FMDVX(L,K)=0.0 + ENDDO + ENDDO + MPI_WTIMES(410)=MPI_WTIMES(410)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(N.EQ.2.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='AHD2.DIA') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='AHD2.DIA') + DO L=2,LA + I=IL(L) + J=JL(L) + DO K=1,KC + WRITE(1,1111)N,I,J,K,FMDUX(L,K),FMDVY(L,K),FMDUY(L,K), + & FMDVX(L,K),AH(L,K),DYU1(L,K),DYV1(L,K) + ENDDO + ENDDO + CLOSE(1) + ENDIF + MPI_WTIMES(411)=MPI_WTIMES(411)+MPI_TOC(S1TIME) + 1111 FORMAT(4I5,7E13.4) + 1112 FORMAT(2I5,8E13.4) + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for new file mode 100644 index 000000000..ff411baaf --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for @@ -0,0 +1,792 @@ + SUBROUTINE CALHEAT_mpi(ISTL_) +C +C Subroutine CALHEAT takes the information from the atmospheric boundary +C file and the wind forcing file and calculates the net heat flux across +C the water surface boundary. The heat flux is then used to update the +C water temperature either in the surface cells, or distributed across +C the cells in the vertical and into the bottom. The subroutine has +C three options these are: +C +C ISOPT(2)=1: Full surface and internal heat transfer calculation +C using meteorologic data from input stream. +C IASWRAD=0: ADSORB SW SOLR RAD TO ALL LAYERS AND BED +C IASWRAD=1: ADSORB SW SOLR RAD TO TO SURFACE LAYER +C ISOPT(2)=2: Transient equilibrium surface heat transfer calculation +C using external equilibrium temperature and heat transfer +C coefficient data from the meteorologic input data. +C ISOPT(2)=3: Equilibrium surface heat transfer calculation using constant +C equilibrium temperature and heat transfer coefficients +C HEQT and TEMO read in through input stream. +C ISOPT(2)=4: Equilibrium surface heat transfer calculation using algorithm +C from CE-QUAL-W2. +C +C The heat flux terms are derived from a paper by Rosati +C and Miyakoda (1988) entitled "A General Circulation Model for Upper Ocean +C Simulation". The heat flux is prescribed by term for the following +C influxes and outfluxes: +C +C - Short Wave Incoming Radiation (+) +C - Net Long Wave Radiation (+/-) +C - Sensible Heat Flux (convection -) +C - Latent Heat Flux (evaporation +/-) +C +C Two formulations of the Latent Heat Flux are provided. The first is from +C the Rosati and Miyakoda paper, the second is an alternate formulation by +C Brady, Graves, and Geyer (1969). The second formulation was taken from +C "Hydrodynamics and Transport for Water Quality Modeling" (Martin and +C McCutcheon, 1999). The Rosati and Miyakoda formulation will have zero +C evaporative cooling or heating if wind speed goes to zero. The Brady, +C Graves, and Geyer formulation provides for a minimum evaporative cooling +C under zero wind speed. +C +C +C VARIABLE LIST: +C +C CLOUDT = Cloud cover (0 to 10) +C HCON = Sensible heat flux (W/m2) +C HLAT = Latent heat flux (W/m2) +C HLWBR = Net longwave radiation (atmospheric long wave plus back +C radiation, W/m2) +C SOLSWRT = Short wave incoming radiation (W/m2) +C SVPW = Saturation vapor pressure in mb based upon the water surface +C temperature +C TATMT = Temperature of air above water surface (deg C) +C TEM = Water temperature in cell (deg C) +C VPA = Vapor pressure of air at near surface air temperature (mb) +C WINDST = Wind speed at 10 meters over cell surface (m/s) +C +C MODIFICATION HISTORY: +C +C Date Author Comments +C ---------- ------------------ --------------------------------------------- +C 06/01/1992 John M. Hamrick Orignial author +C 11/07/2000 Steven Peene Cleaned code, provided more detailed +C descriptions, added alternate formulation +C for latent heat flux, separated out +C individual heat flux terms +C 11/01/2005 Paul M. Craig Added Option 4, to use the Equilibrium Temperature +C algorithym from CE-QUAL-W2. Also added the sub-option +C under this option to couple or decouple the bottom temperature +C to the water column temperatures. +C Added the ability to input spatially variable bed temps and +C thermally active bed thicknesses. +C Also cleaned up the code and added structure. +C +C CHANGE RECORD +C ** SUBROUTINE CALHEAT CALCULATES SURFACE AND INTERNAL HEAT SOURCES +C ** AND SINKS IN THE HEAT (TEM) TRANSPORT EQUATION +C + USE GLOBAL + USE MPI + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::NETRAD + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TBEDTHK + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::HDEP + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RADBOT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::FLUXTB + !REAL,SAVE :: PTIME + !REAL,SAVE :: PMCTOL + REAL K_ABOVE + INTEGER ::NRANK + REAL TSSS_ABOVE + REAL WQCHLS_ABOVE + REAL POMS_ABOVE + TSSS_ABOVE=0.0 + WQCHLS_ABOVE=0.0 + POMS_ABOVE=0.0 +C + IF(.NOT.ALLOCATED(NETRAD))THEN + ALLOCATE(NETRAD(LCM,KCM)) + ALLOCATE(TBEDTHK(LCM)) + ALLOCATE(HDEP(LCM)) + ALLOCATE(RADBOT(LCM)) + ALLOCATE(FLUXTB(LCM)) + RADBOT=0.0 !SCJ + FLUXTB=0.0 !SCJ + + ! *** Ininitialze Heat Exchange Terms + IF(MYRANK.EQ.0) PRINT *,'CALHEAT: INITIALIZING' + CALL HEAT_EXCHANGE + !PMCTOL=0.1 + NETRAD=0. + HDEP=0. + TBEDTHK=0. + IF((ISTOPT(2).EQ.1.AND.IASWRAD.EQ.0).OR.ISTOPT(2).EQ.4)THEN + IF(DABEDT.GT.0.)THEN + IF(MYRANK.EQ.0) + & PRINT *,'CALHEAT: SETTING CONSTANT THICKNESS TO:',DABEDT + DO L=2,LA + TBEDTHK(L)=DABEDT + ENDDO + ELSE + ! *** READ IN THE SPATIALLY VARYING INIT T AND BED THICKNESS (DABEDT) + IF(MYRANK.EQ.0) + & PRINT *,'CALHEAT: READ IN THE SPATIALLY VARYING INIT T AND + & BED THICKNESS: TEMB.INP' + DO L=2,LA + TBEDTHK(L)=ABS(DABEDT) + IF(ISCI(2).EQ.0)TEMB(L)=ABS(TBEDIT) + ENDDO + OPEN(1001,FILE='TEMB.INP',ERR=1000,STATUS='OLD') + DO IS=1,4 + READ(1001,*) + ENDDO + DO L1 = 2, LA + READ(1001,*,END=1000) I,J,T1,T2 + L=LIJ(I,J) + IF(ISCI(2).EQ.0)TEMB(L)=T1 + TBEDTHK(L)=T2 + ENDDO + 1000 CLOSE(1001) + ENDIF + ENDIF + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'1HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +!{GeoSR, YSSONG, ICE COVER, 1111031 +C IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.4)THEN +C DO L=2,LA +C PSHADE(L)=1.0 +C ENDDO +C IF(USESHADE)THEN +C ! *** READ IN THE SPATIALLY VARYING INIT T AND BED THICKNESS (DABEDT) +C PRINT *, +C * 'CALHEAT: READ IN SPATIALLY VARYING SHADE: PSHADE.INP' +C OPEN(1001,FILE='PSHADE.INP',ERR=1010,STATUS='OLD') +C DO IS=1,4 +C READ(1001,*) +C ENDDO +C DO L1 = 2, LA +C READ(1001,*,END=1010) I,J,T1 +C L=LIJ(I,J) +C PSHADE(L)=T1 +C ENDDO +C 1010 CLOSE(1001) +C ELSE +C PRINT *,'CALHEAT: SETTING CONSTANT SHADE TO: 1.0 (NO SHADE)' +C ENDIF +C ENDIF +!} + + IF(DEBUG.AND.MYRANK.EQ.0)THEN + PRINT *,'CALHEAT: Bed Temp(L=2):', TEMB(2) + OPEN(77,file='calheat.dia',status='unknown') + CLOSE(77,status='DELETE') + OPEN(77,file='calheat.dia',status='NEW') + WRITE(77,998)'TIMEDAY','SRON','ET','TD_C','TA_C','TDEW_F', + & 'TAIR_F','FW' + 998 FORMAT(A11,8A9) + ENDIF + ENDIF + +!{GeoSR, YSSONG, ICE COVER, 1111031 + S2TIME=MPI_TIC() + IF(USESHADE)THEN + IF(ISDYNSTP.EQ.0)THEN + TIMTMP=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ELSE + TIMTMP=TIMESEC/86400. + ENDIF + + IF(TIMTMP .GE. SHDDAY)THEN + IF(ISTOPT(2).EQ.1.OR.ISTOPT(2).EQ.4)THEN + DO L=2,LA + PSHADE(L)=1.0 + ENDDO + + IF(N.EQ.1)THEN + ! *** READ IN THE SPATIALLY VARYING INIT T (READ IN SPATIALLY VARYING SHADE: PSHADE.INP') + OPEN(1001,FILE='PSHADE.INP',STATUS='UNKNOWN') +C +C SKIP OVER ALL COMMENT CARDS AT BEGINNING OF FILE: +C + DO NDUM=1,3 + READ(1001,*) + ENDDO +C +C SEQUENTIALLY READ ICE COVER FILE UNTIL THE APPROPRIATE + ENDIF + +C TIME IS FOUND: +C SHDAY = CURRENT DAY AT WHICH ICE COVER IS IN EFFECT +C SHDDAY = NEXT DAY AT WHICH ICE COVER CHANGES (PASSED TO MAIN PROG +C + 10 READ(1001, *, END=15) SHDDAY,NDATASHD + IF(SHDDAY .GT. TIMTMP) GOTO 20 + SHDAY = SHDDAY + DO NDUM=1,NDATASHD + READ(1001,*,END=15) I,J,PSHADE0 + L=LIJ(I,J) + PSHADE(L)=PSHADE0 + ENDDO + GOTO 10 +C +C UNEXPECTED END-OF-FILE ENCOUNTERED: +C + 15 WRITE(2,16) + 16 FORMAT(//,' ************* WARNING *************',/, + & ' END-OF-FILE ENCOUNTERED IN FILE: ', A20,/,/ + & ' ICE COVER PSHADE SET TO VALUES CORRESPONDING ', + & ' TO LAST DAY IN FILE.',/) + SHDDAY=(TCON*TBEGIN + NTC*TIDALP)/86400.0 ! *** PMC SINGLE LINE + 20 CONTINUE + BACKSPACE(1001) + ENDIF + ENDIF + ENDIF + MPI_WTIMES(751)=MPI_WTIMES(751)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'2HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF +!} +C + ! *** DSLLC BEGIN CHANGE +CPMC DELT=DT2 +CPMC IF(ISTL_.EQ.2)THEN +CPMC DELT=DT +CPMC ENDIF +CPMC DELT=DT2 + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + END IF + ELSE + DELT=DT2 + ENDIF + ! *** DSLLC END CHANGE + + ! *** OVERWRITE THE INPUT SOLAR RAD WITH A COMPUTED ONE + IF(COMPUTESOLRAD)THEN + S2TIME=MPI_TIC() + CALL SHORT_WAVE_RADIATION(WINDST(2),RHA(2),TATMT(2),CLOUDT(2), + & PATMT(2),SRO,SRON) + MPI_WTIMES(752)=MPI_WTIMES(752)+MPI_TOC(S2TIME) + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + ! *** USE COMPUTED SRO + SOLSWRT(L)=SRON + ENDDO + MPI_WTIMES(753)=MPI_WTIMES(753)+MPI_TOC(S2TIME) + ENDIF + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'3HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + IF(USESHADE)THEN + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + ! *** APPLY PSHADE FACTORS + SOLSWRT(L)=SOLSWRT(L)*PSHADE(L) + ENDDO + MPI_WTIMES(754)=MPI_WTIMES(754)+MPI_TOC(S2TIME) + ENDIF + IF(ISTOPT(2).EQ.1)THEN + ! *** FULL HEAT BALANCE WITH ATMOSPHERIC LINKAGE + + ! *** SET UP MIN DEPTH + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HDEP(L)=MAX(HP(L),0.) + ENDDO + MPI_WTIMES(755)=MPI_WTIMES(755)+MPI_TOC(S2TIME) + + ! NET HEAT FLUX = RSN+RAN-RB-RE-RC (WATT/M2) + S2TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(SVPW,CLDFAC,RAN,FW,RE,RC,RB) + DO L=LMPI2,LMPILA + SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ + & (1.+0.00412*TEM(L,KC)))) + ! *** Net atmospheric radiation (Diffusive) + CLDFAC=1.0+0.0017*CLOUDT(L)**2 + ! ** .5153153831e-12 = 1000.0/3600.0*9.37E-6*2.0411E-7*0.97 + RAN=0.51531538e-12*(TATMT(L)+273.15)**6*CLDFAC + ! *** Evaporation + FW=9.2+0.46*WINDST(L)**2; + RE=FW*(SVPW-VPA(L)); + ! *** Conduction + RC=0.47*FW*(TEM(L,KC)-TATMT(L)) + ! *** Longwave back radiation + ! *** 5.443E-8 = 5.67E-8 * 0.97 + RB=5.443E-8*(TEM(L,KC)+273.15)**4 + NETRAD(L,KC)=RAN-RB-RE-RC +!{GeoSR, 2015.01.15 JHLEE, NEGATIVE WATER TEMPERATURE PROBLEM + IF(ISICE.EQ.1)THEN + IF(TEM(L,KC).LT.0.0)THEN + NETRAD(L,KC)=0.0 + ENDIF + ENDIF +!} GeoSR, 2015.01.15 JHLEE, NEGATIVE WATER TEMPERATURE PROBLEM + ENDDO + MPI_WTIMES(756)=MPI_WTIMES(756)+MPI_TOC(S2TIME) + ! *** NET SHORTWAVE SOLAR RADIATION + IF(IASWRAD.EQ.0.)THEN + ! *** ADSORB SW SOLR RAD TO ALL LAYERS AND BED + + ! *** SURFACE LAYER + TFAST=SWRATNF*(Z(KC)-1.) + TFAST1=SWRATNF*(Z(KC-1)-1.) + TSLOW=SWRATNS*(Z(KC)-1.) + TSLOW1=SWRATNS*(Z(KC-1)-1.) + S2TIME=MPI_TIC() + IF(FSWRATF.LT.1.)THEN +!$OMP PARALLEL DO PRIVATE(RSN) + DO L=LMPI2,LMPILA + RSN=SOLSWRT(L)* + & ( FSWRATF*(EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) + & +(1.-FSWRATF)*(EXP(TSLOW*HDEP(L))-EXP(TSLOW1*HDEP(L)))) + NETRAD(L,KC)=NETRAD(L,KC)+RSN + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(RSN) + DO L=LMPI2,LMPILA + RSN=SOLSWRT(L)*(1.-EXP(TFAST1*HDEP(L))) + NETRAD(L,KC)=NETRAD(L,KC)+RSN + ENDDO + ENDIF + MPI_WTIMES(757)=MPI_WTIMES(757)+MPI_TOC(S2TIME) + ! *** ALL REMAINING LAYERS + S2TIME=MPI_TIC() + IF(KC.GT.1)THEN + DO K=1,KS + TFAST=SWRATNF*(Z(K)-1.) + TFAST1=SWRATNF*(Z(K-1)-1.) + C2=DELT*DZIC(K)*0.2393E-6 + IF(FSWRATF.LT.1.)THEN + TSLOW=SWRATNS*(Z(K)-1.) + TSLOW1=SWRATNS*(Z(K-1)-1.) +!$OMP PARALLEL DO PRIVATE(RSN) + DO L=LMPI2,LMPILA + RSN=SOLSWRT(L)* + & ( FSWRATF*(EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) + & +(1.-FSWRATF)*(EXP(TSLOW*HDEP(L))-EXP(TSLOW1*HDEP(L)))) + NETRAD(L,K)=RSN + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(RSN) + DO L=LMPI2,LMPILA + RSN=SOLSWRT(L)* + & (EXP(TFAST*HDEP(L))-EXP(TFAST1*HDEP(L))) + NETRAD(L,K)=RSN + ENDDO + ENDIF + ENDDO + ENDIF + MPI_WTIMES(758)=MPI_WTIMES(758)+MPI_TOC(S2TIME) + ! *** Distribute heat flux to the bed for each grid cell. + S2TIME=MPI_TIC() + TFAST=SWRATNF*(Z(0)-1.) + IF(FSWRATF.LT.1.)THEN + TSLOW=SWRATNS*(Z(0)-1.) +!$OMP PARALLEL DO PRIVATE(UBED,VBED,USPD,TMPVAL) + DO L=LMPI2,LMPILA + UBED=0.5*( U(L,1)+U(L+1,1) ) + VBED=0.5*( V(L,1)+V(LNC(L),1) ) + USPD=SQRT( UBED*UBED+VBED*VBED ) + TMPVAL=(HTBED1*USPD+HTBED2)*(TEM(L,1)-TEMB(L)) + NETRAD(L,1)=NETRAD(L,1)-TMPVAL/0.2393E-6 + ! *** UPDATE BOTTOM + IF(TBEDIT.GT.0.)THEN + TEMB(L)=TEMB(L) + (TMPVAL + 0.2393E-6*SOLSWRT(L)* + & (FSWRATF *EXP(TFAST*HDEP(L)) + & +(1.-FSWRATF)*EXP(TSLOW*HDEP(L))))*DELT/TBEDTHK(L) + ENDIF + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(UBED,VBED,USPD,TMPVAL) + DO L=LMPI2,LMPILA + UBED=0.5*( U(L,1)+U(L+1,1) ) + VBED=0.5*( V(L,1)+V(LNC(L),1) ) + USPD=SQRT( UBED*UBED+VBED*VBED ) + TMPVAL=(HTBED1*USPD+HTBED2)*(TEM(L,1)-TEMB(L)) + NETRAD(L,1)=NETRAD(L,1)-TMPVAL/0.2393E-6 + + ! *** UPDATE BOTTOM + IF(TBEDIT.GT.0.)THEN + TEMB(L)=TEMB(L) + (TMPVAL + 0.2393E-6*SOLSWRT(L)* + & FSWRATF*EXP(TFAST*HDEP(L)))*DELT/TBEDTHK(L) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(759)=MPI_WTIMES(759)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'4HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + ! *** NOW FINALIZE THE TEMPERATURE + S2TIME=MPI_TIC() + DO K=1,KC + ! *** RHO = 1000.0 Density (kg / m^3) + ! *** CP = 4179.0 Specific Heat (J / kg / degC) + ! *** 0.2393E-6 = 1/RHO/CP + C1=DELT*DZIC(K)*0.2393E-6 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,K)=TEM(L,K)+HPI(L)*C1*NETRAD(L,K) + ENDDO + ENDDO + IF(ISDRY.GT.0.AND.ISTOPT(2).EQ.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(IMASKDRY(L).EQ.1.) TEMB(L)=TATMT(L) + ENDDO + ENDIF + MPI_WTIMES(760)=MPI_WTIMES(760)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'5HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + + ELSE ! IF(IASWRAD.EQ.1)THEN + + ! *** ADSORB SW SOLR RAD TO TO SURFACE LAYER + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + NETRAD(L,KC)=NETRAD(L,KC)+SOLSWRT(L) + ENDDO + ! *** NOW FINALIZE THE TEMPERATURE + C1=DELT*DZIC(KC)*0.2393E-6 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEM(L,KC)=TEM(L,KC)+HPI(L)*C1*NETRAD(L,KC) + ENDDO + MPI_WTIMES(761)=MPI_WTIMES(761)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'6HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + + ENDIF + + ELSEIF(ISTOPT(2).EQ.2)THEN + + ! *** IMPLEMENT EXTERNALLY SPECIFIED EQUILIBRIUM TEMPERATURE FORMULATION + S2TIME=MPI_TIC() + TMPKC=DELT/DZC(KC) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL +! [ GEOSR 2010.5.13 + TEM(L,KC)=TEM(L,KC)-TMPKC*CLOUDT(L)*HPI(L)*(TEM(L,KC) + & -TATMT(L)) +c TEM(L,KC)=TEM(L,KC)-TMPKC*SOLSWRT(L)*HPI(L)*(TEM(L,KC) +c & -TATMT(L)) +! GEOSR 2010.5.13 ] + ENDDO + ENDDO + MPI_WTIMES(762)=MPI_WTIMES(762)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'7HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + + ELSEIF(ISTOPT(2).EQ.3)THEN + + ! *** IMPLEMENT CONSTANT COEFFICIENT EQUILIBRIUM TEMPERATURE FORMULATION + S2TIME=MPI_TIC() + DTHEQT=DELT*HEQT*FLOAT(KC) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL + TEM(L,KC)=TEM(L,KC)-DTHEQT*HPI(L)*(TEM(L,KC)-TEMO) + ENDDO + ENDDO + MPI_WTIMES(763)=MPI_WTIMES(763)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'8HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + + ELSEIF(ISTOPT(2).EQ.4)THEN + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'9HEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + ! *** IMPLEMENT W2 EQUILIBRIUM TEMPERATURE FORMULATION + S2TIME=MPI_TIC() + IF(.NOT.COMPUTESOLRAD)THEN + ! *** MUST MAKE AT LEAST ONE CALL TO THIS TO INITIALIZE VARIABLES + CALL SHORT_WAVE_RADIATION(WINDST(2),RHA(2),TATMT(2),CLOUDT(2), + & PATMT(2),SRO,SRON) + ENDIF + MPI_WTIMES(764)=MPI_WTIMES(764)+MPI_TOC(S2TIME) + ! *** SWRATNF - Background/Clear Water Extinction Coefficient + ! *** SWRATNS - Light Extinction for TSS (1/m per g/m3) + ! *** FSWRATF - Fraction of Solar Rad Absobed in the Surface Layer + ! *** HTBED2 - Bottom Heat Exchange Coefficient (W/m2/s) + S2TIME=MPI_TIC() + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'AHEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + PSHADE_OLD=-1. + DO NRANK=0,NPROCS-1 + IF(MYRANK.EQ.NRANK)THEN + DO L=LMPI2,LMPILA + IF(PSHADE_OLD.NE.PSHADE(L))THEN + IF(SOLSWRT(L).gt.0.01.OR.PSHADE_OLD.LT.-.99)then + CALL EQUILIBRIUM_TEMPERATURE(SOLSWRT(L),ET,CSHE) + ENDIF + PSHADE_OLD=PSHADE(L) + ENDIF + ! *** SURFACE HEAT FLUX + THICK =HP(L)*DZC(KC) + TFLUX = CSHE*(ET-TEM(L,KC))/THICK*DELT + TEM(L,KC) = TEM(L,KC)+TFLUX + ! *** BEGIN PMC + ! *** TEMPORARY FIX UNTIL BUILD IN ICE SUB-MODEL INTO THE HEAT SUB-MODEL (COOK INLET) + IF(ISTRAN(1)>0)THEN + IF( TEM(L,KC)<-1.3 )THEN + TEM(L,KC) = -1.3*(SAL(L,KC)/35.) + ENDIF + ELSE + IF( TEM(L,KC)<0.1 )THEN + TEM(L,KC) = 0.1 + ENDIF + ENDIF + ! *** END PMC + ! *** BOTTOM HEAT FLUX + THICK = HP(L)*DZC(1) + TFLUX = HTBED2*(TEMB(L)-TEM(L,1))*DELT + TEM(L,1) = TEM(L,1)+TFLUX/THICK + FLUXTB(L)=TFLUX + ENDDO + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + IF(NRANK.LT.NPROCS-1)THEN + IF(MYRANK==NRANK)THEN + CALL MPI_ISEND( PSHADE_OLD,1,MPI_REAL,MYRANK+1,87, + & MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + ELSEIF(MYRANK==NRANK+1)THEN + CALL MPI_IRECV( PSHADE_OLD,1,MPI_REAL,MYRANK-1,87, + & MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + IF(MYRANK==NRANK)THEN + CALL MPI_ISEND( ET,1,MPI_REAL,MYRANK+1,87, + & MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + ELSEIF(MYRANK==NRANK+1)THEN + CALL MPI_IRECV( ET,1,MPI_REAL,MYRANK-1,87, + & MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + IF(MYRANK==NRANK)THEN + CALL MPI_ISEND( CSHE,1,MPI_REAL,MYRANK+1,87, + & MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + ELSEIF(MYRANK==NRANK+1)THEN + CALL MPI_IRECV( CSHE,1,MPI_REAL,MYRANK-1,87, + & MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDIF + ENDDO + MPI_WTIMES(765)=MPI_WTIMES(765)+MPI_TOC(S2TIME) + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + call collect_in_zero(FLUXTB) + call collect_in_zero(TEMB) + call collect_in_zero(SOLSWRT) + call collect_in_zero(PSHADE) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'1FLUXTB = ', sum(abs(dble(FLUXTB))) + PRINT*, n,'1TEMB = ', sum(abs(dble(TEMB))) + PRINT*, n,'1SOLSWRT= ', sum(abs(dble(SOLSWRT))) + PRINT*, n,'1PSHADE = ', sum(abs(dble(PSHADE))) + PRINT*, n,'BHEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + CALL MPI_BCAST(SOLSWRT(2),1,MPI_REAL,0,MPI_COMM_WORLD,IERR) + ! *** Distribute Solar Radiation Across Water Column + IF(SOLSWRT(2).GT.0.1)THEN + S2TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(K,TSS_ABOVE, +!$OMP+ WQCHL_ABOVE,POM_ABOVE,GAMMA,TOP,EXPTOP, +!$OMP+ K_ABOVE,SRON,BOT,EXPBOT) +!$OMP+ FIRSTPRIVATE(TSSS_ABOVE,WQCHLS_ABOVE,POMS_ABOVE) + DO L=LMPI2,LMPILA + K=KC + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + TSSS_ABOVE=SNDT(L,K)+SEDT(L,K) + TSS_ABOVE=TSSS_ABOVE + ELSE + TSS_ABOVE=0.0 + ENDIF + IF(ISTRAN(8).GT.0)THEN + ! *** Water Quality is Active so account for Chlorophyll and POM + ! *** If using WQ then use the WQ Coefficients + WQCHLS_ABOVE=WQCHL(L,K) + WQCHL_ABOVE=WQCHLS_ABOVE + POMS_ABOVE=WQV(L,K,4)+WQV(L,K,5) + POM_ABOVE =POMS_ABOVE + GAMMA = WQKEB(1) + WQKETSS*TSS_ABOVE + + & WQKECHL*WQCHL_ABOVE + + & WQKEPOM*POM_ABOVE + ELSE + GAMMA = SWRATNF + SWRATNS*TSS_ABOVE + ENDIF + + TOP=GAMMA*HP(L)*(Z(K-1)-1.) + EXPTOP=EXP(TOP) + K_ABOVE=1. + + ! *** ENSURE AT LEAST THE FSWRATF FRACTION OF SRO IS ATTENUATED + IF((1.-EXPTOP).GT.FSWRATF)THEN + SRON=SOLSWRT(L)*EXPTOP + ELSE + SRON=SOLSWRT(L)*(1.0-FSWRATF) + ENDIF + EXPBOT=0.0 + DO K = KS,1,-1 + ! *** Net Extinction Coefficient + K_ABOVE=K_ABOVE+1. + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + TSSS_ABOVE=TSSS_ABOVE+SNDT(L,K)+SEDT(L,K) + TSS_ABOVE=TSSS_ABOVE/K_ABOVE + ENDIF + IF(ISTRAN(8).GT.0)THEN + ! *** Water Quality is Active so account for Chlorophyll + ! *** If using WQ then use the WQ Coefficients + POMS_ABOVE=POMS_ABOVE+WQV(L,K,4)+WQV(L,K,5) + POM_ABOVE=POMS_ABOVE/K_ABOVE + + WQCHLS_ABOVE=WQCHLS_ABOVE+WQCHL(L,K) + WQCHL_ABOVE=WQCHLS_ABOVE/K_ABOVE + GAMMA = WQKEB(1) + WQKETSS*TSS_ABOVE + + & WQKECHL*WQCHL_ABOVE + + & WQKEPOM*POM_ABOVE + ELSE + GAMMA = SWRATNF + SWRATNS*TSS_ABOVE + ENDIF + + BOT=GAMMA*HP(L)*(Z(K-1)-1.) + + ! *** Compute Net Energy + EXPBOT=EXP(BOT) + NETRAD(L,K)=SRON*(EXPTOP-EXPBOT) + TOP=BOT + EXPTOP=EXPBOT + ENDDO + RADBOT(L)=EXPBOT*SRON + ENDDO + MPI_WTIMES(766)=MPI_WTIMES(766)+MPI_TOC(S2TIME) + ! *** NOW FINALIZE THE TEMPERATURE + S2TIME=MPI_TIC() + DO K=1,KS + ! *** RHO = 1000.0 Density (kg / m^3) + ! *** CP = 4179.0 Specific Heat (J / kg / degC) + ! *** 0.2393E-6 = 1/RHO/CP --> Conversion from Watts + C1=DELT*DZIC(K)*0.2393E-6 +C!$OMP PARALLEL DO PRIVATE(TEMO) + DO L=LMPI2,LMPILA + TEMO=TEM(L,K)+HPI(L)*C1*NETRAD(L,K) + !IF(ABS(TEM(L,K)-TEMO).GT.PMCTOL)THEN + ! IPMC=0 + !ENDIF + TEM(L,K)=TEMO + ENDDO + ENDDO + MPI_WTIMES(767)=MPI_WTIMES(767)+MPI_TOC(S2TIME) + CALL MPI_BCAST(TEMO,1,MPI_REAL,NPROCS-1,MPI_COMM_WORLD,IERR) + ENDIF + + ! *** UPDATE BOTTOM + S2TIME=MPI_TIC() + IF(TBEDIT.GT.0.)THEN + IF(SOLSWRT(2).GT.0.01.AND.BETAF.GT.0.)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEMB(L)=TEMB(L) + + & (0.2393E-6*RADBOT(L)*DELT*BETAF - FLUXTB(L)) + & /TBEDTHK(L) + ENDDO + ELSE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TEMB(L)=TEMB(L) - FLUXTB(L)/TBEDTHK(L) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(768)=MPI_WTIMES(768)+MPI_TOC(S2TIME) + ENDIF + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + call collect_in_zero(FLUXTB) + call collect_in_zero(TEMB) + call collect_in_zero(SOLSWRT) + call collect_in_zero(PSHADE) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'2FLUXTB = ', sum(abs(dble(FLUXTB))) + PRINT*, n,'2TEMB = ', sum(abs(dble(TEMB))) + PRINT*, n,'2SOLSWRT= ', sum(abs(dble(SOLSWRT))) + PRINT*, n,'2PSHADE = ', sum(abs(dble(PSHADE))) + PRINT*, n,'CHEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + ! *** APPLY DRY CELL CORRECTIONS + S2TIME=MPI_TIC() + IF(ISDRY.GT.0)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(.NOT.LMASKDRY(L))THEN + TEM(L,K)=TATMT(L) + ! *** BEGIN PMC + ! *** TEMPORARY FIX UNTIL BUILD IN ICE SUB-MODEL INTO THE HEAT SUB-MODEL (COOK INLET) + IF(ISTRAN(1)>0)THEN + IF( TEM(L,K)<-1.3 )THEN + TEM(L,K) = -1.3*(SAL(L,K)/35.) + ENDIF + ELSE + IF( TEM(L,K)<0.1 )THEN + TEM(L,K) = 0.1 + ENDIF + ENDIF + ! *** END PMC + ENDIF + ENDDO + ENDDO + ENDIF + IF(PRINT_SUM)THEN + call collect_in_zero_array(TEM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'DHEAT = ', sum(abs(dble(TEM))) + ENDIF + ENDIF + MPI_WTIMES(769)=MPI_WTIMES(769)+MPI_TOC(S2TIME) + +C 600 FORMAT(4I5,2E12.4) + + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for new file mode 100644 index 000000000..2eb9d4c4d --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for @@ -0,0 +1,992 @@ + SUBROUTINE CALMMT_mpi +C +C CHANGE RECORD +C ** SUBROUTINE CALMMTF CALCULATES THE MEAN MASS TRANSPORT FIELD +C + USE GLOBAL + USE MPI +C + LOGICAL INITIALIZE + DATA INITIALIZE/.TRUE./ +C +C ** INITIALIZE CE-QUAL-ICM INTERFACE +C + IF(ISICM.GE.1.AND.JSWASP.EQ.1) CALL CEQICM +C + IF(.NOT.INITIALIZE)GOTO 100 + INITIALIZE=.FALSE. + IF(NTSMMT.LT.NTSPTC)THEN + DO L=1,LC + HLPF(L)=0. + QSUMELPF(L)=0. + UELPF(L)=0. + VELPF(L)=0. + RAINLPF(L)=0. + EVPSLPF(L)=0. + EVPGLPF(L)=0. + RINFLPF(L)=0. + GWLPF(L)=0. + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=1,LC + SEDBLPF(L,K,NSC)=0. + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=1,LC + SNDBLPF(L,K,NSN)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KB + DO L=1,LC + TOXBLPF(L,K,NT)=0. + ENDDO + ENDDO + ENDDO + HLPF(1)=HMIN + HLPF(LC)=HMIN + DO K=1,KS + DO L=1,LC + ABLPF(L,K)=0. + ABEFF(L,K)=0. + WLPF(L,K)=0. + ENDDO + ENDDO + DO K=1,KC + DO L=1,LC + AHULPF(L,K)=0. + AHVLPF(L,K)=0. + SALLPF(L,K)=0. + TEMLPF(L,K)=0. + SFLLPF(L,K)=0. + DYELPF(L,K)=0. + UHLPF(L,K)=0. + VHLPF(L,K)=0. + QSUMLPF(L,K)=0. + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=1,LC + SEDLPF(L,K,NSC)=0. + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=1,LC + SNDLPF(L,K,NSN)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=1,LC + TOXLPF(L,K,NT)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=0. + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=0. + QSRTLPN(K,NS)=0. + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=0. + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=0. + QCHNVLP(NMD)=0. + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=0. + ENDDO + ELSE + DO L=1,LC + HLPF(L)=0. + QSUMELPF(L)=0. + UELPF(L)=0. + VELPF(L)=0. + RAINLPF(L)=0. + EVPSLPF(L)=0. + EVPGLPF(L)=0. + RINFLPF(L)=0. + GWLPF(L)=0. + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=1,LC + SEDBLPF(L,K,NSC)=0. + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=1,LC + SNDBLPF(L,K,NSN)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KB + DO L=1,LC + TOXBLPF(L,K,NT)=0. + ENDDO + ENDDO + ENDDO + HLPF(1)=HMIN + HLPF(LC)=HMIN + DO K=1,KS + DO L=1,LC + ABLPF(L,K)=0. + WIRT(L,K)=0. + WLPF(L,K)=0. + WTLPF(L,K)=0. + ENDDO + ENDDO + DO K=1,KC + DO L=1,LC + AHULPF(L,K)=0. + AHVLPF(L,K)=0. + SALLPF(L,K)=0. + TEMLPF(L,K)=0. + SFLLPF(L,K)=0. + DYELPF(L,K)=0. + UHLPF(L,K)=0. + UIRT(L,K)=0. + ULPF(L,K)=0. + UTLPF(L,K)=0. + VHLPF(L,K)=0. + QSUMLPF(L,K)=0. + VIRT(L,K)=0. + VLPF(L,K)=0. + VTLPF(L,K)=0. + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=1,LC + SEDLPF(L,K,NSC)=0. + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=1,LC + SNDLPF(L,K,NSN)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=1,LC + TOXLPF(L,K,NT)=0. + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=0. + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=0. + QSRTLPN(K,NS)=0. + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=0. + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=0. + QCHNVLP(NMD)=0. + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=0. + ENDDO + ENDIF +C +C ** ACCUMULATE FILTERED VARIABLES AND DISPLACEMENTS +C + 100 CONTINUE + IF(NTSMMT.LT.NTSPTC)THEN + DO L=2,LA + LN=LNC(L) + HLPF(L)=HLPF(L)+HP(L) + QSUMELPF(L)=QSUMELPF(L)+QSUME(L) + UTMP1=0.5*(UHDYE(L+1)+UHDYE(L))/(DYP(L)*HP(L)) + VTMP1=0.5*(VHDXE(LN)+VHDXE(L))/(DXP(L)*HP(L)) + UTMP=CUE(L)*UTMP1+CVE(L)*VTMP1 + VTMP=CUN(L)*UTMP1+CVN(L)*VTMP1 + UELPF(L)=UELPF(L)+UTMP + VELPF(L)=VELPF(L)+VTMP + RAINLPF(L)=RAINLPF(L)+DXYP(L)*RAINT(L) + ENDDO + IF(ISGWIE.EQ.0)THEN + DO L=2,LA + EVPSLPF(L)=EVPSLPF(L)+DXYP(L)*EVAPT(L) + EVPGLPF(L)=0. + RINFLPF(L)=0. + GWLPF(L)=0. + ENDDO + ELSE + DO L=2,LA + EVPSLPF(L)=EVPSLPF(L)+EVAPSW(L) + EVPGLPF(L)=EVPGLPF(L)+EVAPGW(L) + RINFLPF(L)=RINFLPF(L)+RIFTR(L) + GWLPF(L)=GWLPF(L)+AGWELV(L) + ENDDO + ENDIF + DO NT=1,NTOX + DO K=1,KB + DO L=2,LA + TOXBLPF(L,K,NT)=TOXBLPF(L,K,NT)+TOXB(L,K,NT) + ENDDO + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=2,LA + SEDBLPF(L,K,NSC)=SEDBLPF(L,K,NSC)+SEDB(L,K,NSC) + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=2,LA + SNDBLPF(L,K,NSN)=SNDBLPF(L,K,NSN)+SNDB(L,K,NSN) + ENDDO + ENDDO + ENDDO + IF(ISWASP.EQ.99.OR.ISICM.GE.1)THEN + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=ABLPF(L,K)+(AB(L,K)*HP(L)) + ABEFF(L,K)=ABEFF(L,K)+AB(L,K)*(SAL(L,K+1)-SAL(L,K)) + WLPF(L,K)=WLPF(L,K)+W(L,K) + ENDDO + ENDDO + ELSE + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=ABLPF(L,K)+AB(L,K) + ABEFF(L,K)=ABEFF(L,K)+AB(L,K)*(SAL(L,K+1)-SAL(L,K)) + WLPF(L,K)=WLPF(L,K)+W(L,K) + ENDDO + ENDDO + ENDIF + DO K=1,KC + DO L=2,LA + LS=LSC(L) + AHULPF(L,K)=AHULPF(L,K)+0.5*(AH(L,K)+AH(L-1,K)) + AHVLPF(L,K)=AHVLPF(L,K)+0.5*(AH(L,K)+AH(LS,K)) + SALLPF(L,K)=SALLPF(L,K)+SAL(L,K) + TEMLPF(L,K)=TEMLPF(L,K)+TEM(L,K) + SFLLPF(L,K)=SFLLPF(L,K)+SFL(L,K) + DYELPF(L,K)=DYELPF(L,K)+DYE(L,K) + UHLPF(L,K)=UHLPF(L,K)+UHDYWQ(L,K)/DYU(L) + VHLPF(L,K)=VHLPF(L,K)+VHDXWQ(L,K)/DXV(L) + QSUMLPF(L,K)=QSUMLPF(L,K)+QSUM(L,K) + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=2,LA + TOXLPF(L,K,NT)=TOXLPF(L,K,NT)+TOX(L,K,NT) + ENDDO + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=2,LA + SEDLPF(L,K,NSC)=SEDLPF(L,K,NSC)+SED(L,K,NSC) + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=2,LA + SNDLPF(L,K,NSN)=SNDLPF(L,K,NSN)+SND(L,K,NSN) + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=TXPFLPF(L,K,NS,NT)+TOXPFW(L,K,NS,NT) + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=QSRTLPP(K,NS)+MAX(QSERT(K,NS),0.) + QSRTLPN(K,NS)=QSRTLPN(K,NS)+MIN(QSERT(K,NS),0.) + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=QCTLTLP(K,NS)+QCTLT(K,NS) + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=QCHNULP(NMD)+QCHANU(NMD) + QCHNVLP(NMD)=QCHNVLP(NMD)+QCHANV(NMD) + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=QWRSERTLP(NWR)+QWRSERT(NWR) + ENDDO + ELSE + DO L=2,LA + LN=LNC(L) + HLPF(L)=HLPF(L)+HP(L) + QSUMELPF(L)=QSUMELPF(L)+QSUME(L) + UTMP1=0.5*(UHDYE(L+1)+UHDYE(L))/(DYP(L)*HP(L)) + VTMP1=0.5*(VHDXE(LN)+VHDXE(L))/(DXP(L)*HP(L)) + UTMP=CUE(L)*UTMP1+CVE(L)*VTMP1 + VTMP=CUN(L)*UTMP1+CVN(L)*VTMP1 + UELPF(L)=UELPF(L)+UTMP + VELPF(L)=VELPF(L)+VTMP + RAINLPF(L)=RAINLPF(L)+DXYP(L)*RAINT(L) + ENDDO + IF(ISGWIE.EQ.0)THEN + DO L=2,LA + EVPSLPF(L)=EVPSLPF(L)+DXYP(L)*EVAPT(L) + EVPGLPF(L)=0. + RINFLPF(L)=0. + GWLPF(L)=0. + ENDDO + ELSE + DO L=2,LA + EVPSLPF(L)=EVPSLPF(L)+EVAPSW(L) + EVPGLPF(L)=EVPGLPF(L)+EVAPGW(L) + RINFLPF(L)=RINFLPF(L)+RIFTR(L) + GWLPF(L)=GWLPF(L)+AGWELV(L) + ENDDO + ENDIF + DO NT=1,NTOX + DO K=1,KB + DO L=2,LA + TOXBLPF(L,K,NT)=TOXBLPF(L,K,NT)+TOXB(L,K,NT) + ENDDO + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=2,LA + SEDBLPF(L,K,NSC)=SEDBLPF(L,K,NSC)+SEDB(L,K,NSC) + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=2,LA + SNDBLPF(L,K,NSN)=SNDBLPF(L,K,NSN)+SNDB(L,K,NSN) + ENDDO + ENDDO + ENDDO + IF(ISWASP.EQ.99.OR.ISICM.GE.1)THEN + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=ABLPF(L,K)+(AB(L,K)*HP(L)) + ABEFF(L,K)=ABEFF(L,K)+AB(L,K)*(SAL(L,K+1)-SAL(L,K)) + WIRT(L,K)=WIRT(L,K)+DT*W(L,K) + WLPF(L,K)=WLPF(L,K)+W(L,K) + WTLPF(L,K)=WTLPF(L,K)+DT*(FLOAT(NMMT)-0.5)*W(L,K) + ENDDO + ENDDO + ELSE + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=ABLPF(L,K)+AB(L,K) + ABEFF(L,K)=ABEFF(L,K)+AB(L,K)*(SAL(L,K+1)-SAL(L,K)) + WIRT(L,K)=WIRT(L,K)+DT*W(L,K) + WLPF(L,K)=WLPF(L,K)+W(L,K) + WTLPF(L,K)=WTLPF(L,K)+DT*(FLOAT(NMMT)-0.5)*W(L,K) + ENDDO + ENDDO + ENDIF + DO K=1,KC + DO L=2,LA + LS=LSC(L) + AHULPF(L,K)=AHULPF(L,K)+0.5*(AH(L,K)+AH(L-1,K)) + AHVLPF(L,K)=AHVLPF(L,K)+0.5*(AH(L,K)+AH(LS,K)) + SALLPF(L,K)=SALLPF(L,K)+SAL(L,K) + TEMLPF(L,K)=TEMLPF(L,K)+TEM(L,K) + SFLLPF(L,K)=SFLLPF(L,K)+SFL(L,K) + DYELPF(L,K)=DYELPF(L,K)+DYE(L,K) + UHLPF(L,K)=UHLPF(L,K)+UHDYWQ(L,K)/DYU(L) + UIRT(L,K)=UIRT(L,K)+DT*U(L,K) + ULPF(L,K)=ULPF(L,K)+U(L,K) + UTLPF(L,K)=UTLPF(L,K)+DT*(FLOAT(NMMT)-0.5)*U(L,K) + VHLPF(L,K)=VHLPF(L,K)+VHDXWQ(L,K)/DXV(L) + QSUMLPF(L,K)=QSUMLPF(L,K)+QSUM(L,K) + VIRT(L,K)=VIRT(L,K)+DT*V(L,K) + VLPF(L,K)=VLPF(L,K)+V(L,K) + VTLPF(L,K)=VTLPF(L,K)+DT*(FLOAT(NMMT)-0.5)*V(L,K) + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=2,LA + TOXLPF(L,K,NT)=TOXLPF(L,K,NT)+TOX(L,K,NT) + ENDDO + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=2,LA + SEDLPF(L,K,NSC)=SEDLPF(L,K,NSC)+SED(L,K,NSC) + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=2,LA + SNDLPF(L,K,NSN)=SNDLPF(L,K,NSN)+SND(L,K,NSN) + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=TXPFLPF(L,K,NS,NT)+TOXPFW(L,K,NS,NT) + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=QSRTLPP(K,NS)+MAX(QSERT(K,NS),0.) + QSRTLPN(K,NS)=QSRTLPN(K,NS)+MIN(QSERT(K,NS),0.) + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=QCTLTLP(K,NS)+QCTLT(K,NS) + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=QCHNULP(NMD)+QCHANU(NMD) + QCHNVLP(NMD)=QCHNVLP(NMD)+QCHANV(NMD) + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=QWRSERTLP(NWR)+QWRSERT(NWR) + ENDDO + DO K=1,KS + DO L=2,LA + LS=LSC(L) + VPX(L,K)=VPX(L,K)+0.25*(V(L,K+1)+V(L,K))*(WIRT(L,K)+ + & WIRT(LS,K)) + VPY(L,K)=VPY(L,K)+0.25*(W(L,K)+W(L-1,K))*(UIRT(L,K+1)+ + & UIRT(L,K)) + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + LS=LSC(L) + VPZ(L,K)=VPZ(L,K)+0.25*(U(L,K)+U(LS,K))*(VIRT(L,K)+VIRT( + & L-1,K)) + ENDDO + ENDDO + ENDIF +C +C ** CHECK FOR END OF FILTER +C + IF(NMMT.LT.NTSMMT) GOTO 200 +C +C ** COMPLETE THE FILTERING +C + FLTWT=1./FLOAT(NTSMMT) + IF(ISICM.GE.1) FLTWT=2.*FLTWT + IF(NTSMMT.LT.NTSPTC)THEN + DO L=2,LA + HLPF(L)=FLTWT*HLPF(L) + QSUMELPF(L)=FLTWT*QSUMELPF(L) + UELPF(L)=FLTWT*UELPF(L) + VELPF(L)=FLTWT*VELPF(L) + RAINLPF(L)=FLTWT*RAINLPF(L) + EVPSLPF(L)=FLTWT*EVPSLPF(L) + EVPGLPF(L)=FLTWT*EVPGLPF(L) + RINFLPF(L)=FLTWT*RINFLPF(L) + GWLPF(L)=FLTWT*GWLPF(L) + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=2,LA + SEDBLPF(L,K,NSC)=SEDBLPF(L,K,NSC)*FLTWT + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=2,LA + SNDBLPF(L,K,NSN)=SNDBLPF(L,K,NSN)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KB + DO L=2,LA + TOXBLPF(L,K,NT)=TOXBLPF(L,K,NT)*FLTWT + ENDDO + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=FLTWT*ABLPF(L,K) + ABEFF(L,K)=FLTWT*ABEFF(L,K) + WLPF(L,K)=FLTWT*WLPF(L,K) + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + AHULPF(L,K)=AHULPF(L,K)*FLTWT + AHVLPF(L,K)=AHVLPF(L,K)*FLTWT + SALLPF(L,K)=SALLPF(L,K)*FLTWT + TEMLPF(L,K)=TEMLPF(L,K)*FLTWT + SFLLPF(L,K)=SFLLPF(L,K)*FLTWT + DYELPF(L,K)=DYELPF(L,K)*FLTWT + UHLPF(L,K)=FLTWT*UHLPF(L,K) + VHLPF(L,K)=FLTWT*VHLPF(L,K) + QSUMLPF(L,K)=FLTWT*QSUMLPF(L,K) + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=2,LA + SEDLPF(L,K,NSC)=SEDLPF(L,K,NSC)*FLTWT + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=2,LA + SNDLPF(L,K,NSN)=SNDLPF(L,K,NSN)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=2,LA + TOXLPF(L,K,NT)=TOXLPF(L,K,NT)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=TXPFLPF(L,K,NS,NT)*FLTWT + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=FLTWT*QSRTLPP(K,NS) + QSRTLPN(K,NS)=FLTWT*QSRTLPN(K,NS) + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=FLTWT*QCTLTLP(K,NS) + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=FLTWT*QCHNULP(NMD) + QCHNVLP(NMD)=FLTWT*QCHNVLP(NMD) + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=FLTWT*QWRSERTLP(NWR) + ENDDO + ELSE + DO L=2,LA + HLPF(L)=FLTWT*HLPF(L) + QSUMELPF(L)=FLTWT*QSUMELPF(L) + UELPF(L)=FLTWT*UELPF(L) + VELPF(L)=FLTWT*VELPF(L) + RAINLPF(L)=FLTWT*RAINLPF(L) + EVPSLPF(L)=FLTWT*EVPSLPF(L) + EVPGLPF(L)=FLTWT*EVPGLPF(L) + RINFLPF(L)=FLTWT*RINFLPF(L) + GWLPF(L)=FLTWT*GWLPF(L) + ENDDO + DO NSC=1,NSED + DO K=1,KB + DO L=2,LA + SEDBLPF(L,K,NSC)=SEDBLPF(L,K,NSC)*FLTWT + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KB + DO L=2,LA + SNDBLPF(L,K,NSN)=SNDBLPF(L,K,NSN)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KB + DO L=2,LA + TOXBLPF(L,K,NT)=TOXBLPF(L,K,NT)*FLTWT + ENDDO + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA + ABLPF(L,K)=FLTWT*ABLPF(L,K) + ABEFF(L,K)=FLTWT*ABEFF(L,K) + VPX(L,K)=FLTWT*VPX(L,K) + VPY(L,K)=FLTWT*VPY(L,K) + WLPF(L,K)=FLTWT*WLPF(L,K) + WTLPF(L,K)=FLTWT*WTLPF(L,K) + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + AHULPF(L,K)=AHULPF(L,K)*FLTWT + AHVLPF(L,K)=AHVLPF(L,K)*FLTWT + SALLPF(L,K)=FLTWT*SALLPF(L,K) + TEMLPF(L,K)=FLTWT*TEMLPF(L,K) + SFLLPF(L,K)=FLTWT*SFLLPF(L,K) + DYELPF(L,K)=FLTWT*DYELPF(L,K) + UHLPF(L,K)=FLTWT*UHLPF(L,K) + ULPF(L,K)=FLTWT*ULPF(L,K) + UTLPF(L,K)=FLTWT*UTLPF(L,K) + VHLPF(L,K)=FLTWT*VHLPF(L,K) + QSUMLPF(L,K)=FLTWT*QSUMLPF(L,K) + VLPF(L,K)=FLTWT*VLPF(L,K) + VTLPF(L,K)=FLTWT*VTLPF(L,K) + VPZ(L,K)=FLTWT*VPZ(L,K) + ENDDO + ENDDO + DO NSC=1,NSED + DO K=1,KC + DO L=2,LA + SEDLPF(L,K,NSC)=SEDLPF(L,K,NSC)*FLTWT + ENDDO + ENDDO + ENDDO + DO NSN=1,NSND + DO K=1,KC + DO L=2,LA + SNDLPF(L,K,NSN)=SNDLPF(L,K,NSN)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO K=1,KC + DO L=2,LA + TOXLPF(L,K,NT)=TOXLPF(L,K,NT)*FLTWT + ENDDO + ENDDO + ENDDO + DO NT=1,NTOX + DO NS=1,NSED+NSND + DO K=1,KC + DO L=1,LC + TXPFLPF(L,K,NS,NT)=TXPFLPF(L,K,NS,NT)*FLTWT + ENDDO + ENDDO + ENDDO + ENDDO + DO NS=1,NQSER + DO K=1,KC + QSRTLPP(K,NS)=FLTWT*QSRTLPP(K,NS) + QSRTLPN(K,NS)=FLTWT*QSRTLPN(K,NS) + ENDDO + ENDDO + DO NS=1,NQCTL + DO K=1,KC + QCTLTLP(K,NS)=FLTWT*QCTLTLP(K,NS) + ENDDO + ENDDO + DO NMD=1,MDCHH + QCHNULP(NMD)=FLTWT*QCHNULP(NMD) + QCHNVLP(NMD)=FLTWT*QCHNVLP(NMD) + ENDDO + DO NWR=1,NQWR + QWRSERTLP(NWR)=FLTWT*QWRSERTLP(NWR) + ENDDO + DO K=1,KS + DO L=2,LA + LS=LSC(L) + VPX(L,K)=VPX(L,K) + & -0.25*(VTLPF(L,K+1)+VTLPF(L,K))*(WLPF(L,K)+WLPF(LS,K)) + VPY(L,K)=VPY(L,K) + & -0.25*(WTLPF(L,K)+WTLPF(L-1,K))*(ULPF(L,K+1)+ULPF(L,K)) + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + LS=LSC(L) + LSW=LSWC(L) + VPZ(L,K)=VPZ(L,K) + & -0.25*(UTLPF(L,K)+UTLPF(LS,K))*(VLPF(L,K)+VLPF(L-1,K)) + ! *** DSLLC BEGIN BLOCK + TMPVAL=1.+SUB(L)+SVB(L)+SUB(L)*SVB(L) + HPLW =SUB(L)*HP(L-1) + HPLS =SVB(L)*HP(LS) + HPLSW=SUB(L)*SVBO(L)*HP(LSW) + HMC=(HP(L)+HPLW+HPLS+HPLSW)/TMPVAL + VPZ(L,K)=VPZ(L,K)*HMC*SUB(L)*SUB(LS)*SVB(L)*SVB(L-1) + ! *** DSLLC END BLOCK + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + LS=LSC(L) + LN=LNC(L) + UVPT(L,K)=(VPZ(LN,K)-VPZ(L,K))/DYU(L) + & -DZIC(K)*(VPY(L,K)-VPY(L,K-1)) + VVPT(L,K)=DZIC(K)*(VPX(L,K)-VPX(L,K-1)) + & -(VPZ(L+1,K)-VPZ(L,K))/DXV(L) + ENDDO + ENDDO + DO K=1,KS + DO L=2,LA + LS=LSC(L) + LN=LNC(L) + WVPT(L,K)=(VPY(L+1,K)-VPY(L,K))/DXP(L)-(VPX(LN,K)-VPX(L,K) + & )/DYP(L) + ENDDO + ENDDO + ENDIF + QXW=0. + QXWVP=0. + DO K=1,KC + DO LL=1,NPBW + L=LPBW(LL) + QXW=QXW+UHLPF(L+1,K)*DZC(K)*DYU(L+1) + QXWVP=QXWVP+UVPT(L+1,K)*DZC(K)*DYU(L+1) + ENDDO + ENDDO + QXE=0. + QXEVP=0. + DO K=1,KC + DO LL=1,NPBE + L=LPBE(LL) + QXE=QXE+UHLPF(L,K)*DZC(K)*DYU(L) + QXEVP=QXEVP+UVPT(L,K)*DZC(K)*DYU(L) + ENDDO + ENDDO + QYS=0. + QYSVP=0. + DO K=1,KC + DO LL=1,NPBS + L=LPBS(LL) + LN=LNC(L) + QYS=QYS+VHLPF(LN,K)*DZC(K)*DXV(LN) + QYSVP=QYSVP+VVPT(LN,K)*DZC(K)*DXV(LN) + ENDDO + ENDDO + QYN=0. + QYNVP=0. + DO K=1,KC + DO LL=1,NPBN + L=LPBN(LL) + LN=LNC(L) + QYN=QYN+VHLPF(L,K)*DZC(K)*DXV(L) + QYNVP=QYNVP+VVPT(L,K)*DZC(K)*DXV(L) + ENDDO + ENDDO +C +C ** OUTPUT RESIDUAL TRANSPORT TO FILE RESTRAN.OUT +C + IF(ISSSMMT.EQ.1.AND.N.LT.NTS) GOTO 198 + IF(ISRESTR.EQ.1)THEN + IF(MYRANK.EQ.0)THEN + IF(JSRESTR.EQ.1)THEN + OPEN(98,FILE='RESTRAN.OUT',STATUS='UNKNOWN') + CLOSE(98,STATUS='DELETE') + OPEN(98,FILE='RESTRAN.OUT',STATUS='UNKNOWN') + JSRESTR=0 + ELSE + OPEN(98,FILE='RESTRAN.OUT',POSITION='APPEND',STATUS='UNKNOWN') + ENDIF + IF(NTSMMT.LT.NTSPTC)THEN + DO LT=2,LALT + I=ILLT(LT) + J=JLLT(LT) + L=LIJ(I,J) + WRITE(98,907)HMP(L),HLPF(L),QSUMELPF(L) + WRITE(98,907)(UHLPF(L,K),K=1,KC) + WRITE(98,907)(VHLPF(L,K),K=1,KC) + WRITE(98,907)(AHULPF(L,K),K=1,KC) + WRITE(98,907)(AHVLPF(L,K),K=1,KC) + WRITE(98,907)(SALLPF(L,K),K=1,KC) + WRITE(98,907)(ABLPF(L,K),K=1,KS) + WRITE(98,907)(ABEFF(L,K),K=1,KS) + ENDDO + ELSE + DO LT=2,LALT + I=ILLT(LT) + J=JLLT(LT) + L=LIJ(I,J) + WRITE(98,907)HMP(L),HLPF(L),QSUMELPF(L) + WRITE(98,907)(UHLPF(L,K),K=1,KC) + WRITE(98,907)(VHLPF(L,K),K=1,KC) + WRITE(98,907)(VPZ(L,K),K=1,KC) + WRITE(98,907)(AHULPF(L,K),K=1,KC) + WRITE(98,907)(AHVLPF(L,K),K=1,KC) + WRITE(98,907)(SALLPF(L,K),K=1,KC) + WRITE(98,907)(VPX(L,K),K=1,KS) + WRITE(98,907)(VPY(L,K),K=1,KS) + WRITE(98,907)(ABLPF(L,K),K=1,KS) + ENDDO + ENDIF + CLOSE(98) + ENDIF + ENDIF + 907 FORMAT(12E12.4) +C +C ** OUTPUT TO WASP COMPATIABLE FILES +C + IF(ISWASP.EQ.4) CALL WASP4 + IF(ISWASP.EQ.5) CALL WASP5 + IF(ISWASP.EQ.6) CALL WASP6 + IF(ISWASP.EQ.7) CALL WASP7 + IF(ISWASP.EQ.17) CALL WASP7EPA + IF(ISRCA.GE.1) CALL RCAHQ + IF(ISICM.GE.1) CALL CEQICM + 198 CONTINUE +C +C ** WRITE GRAPHICS FILES FOR RESIDUAL VARIABLES +C + IF(ISSSMMT.EQ.1.AND.N.LT.NTS) GOTO 199 +C +C ** RESIDUAL SALINITY CONTOURING IN HORIZONTAL: SUBROUTINE RSALPLTH +C + IF(ISRSPH(1).EQ.1.AND.ISTRAN(1).GE.1)THEN + CALL RSALPLTH(1,SALLPF) + ENDIF + IF(ISRSPH(2).EQ.1.AND.ISTRAN(2).GE.1)THEN + CALL RSALPLTH(2,TEMLPF) + ENDIF + IF(ISRSPH(3).EQ.1.AND.ISTRAN(3).GE.1)THEN + CALL RSALPLTH(3,DYELPF) + ENDIF + IF(ISRSPH(4).EQ.1.AND.ISTRAN(4).GE.1)THEN + CALL RSALPLTH(4,SFLLPF) + ENDIF + DO K=2,KB + DO L=2,LA + SEDBTLPF(L,K)=0. + SNDBTLPF(L,K)=0. + ENDDO + ENDDO + DO K=1,KC + DO L=2,LA + TVAR1S(L,K)=TOXLPF(L,K,1) + SEDTLPF(L,K)=0. + SNDTLPF(L,K)=0. + ENDDO + ENDDO + IF(ISRSPH(5).EQ.1.AND.ISTRAN(5).GE.1)THEN + DO NT=1,NTOX + CALL RSALPLTH(5,TVAR1S) + ENDDO + ENDIF + DO NS=1,NSED + DO K=1,KB + DO L=2,LA + SEDBTLPF(L,K)=SEDBTLPF(L,K)+SEDBLPF(L,K,NS) + ENDDO + ENDDO + ENDDO + DO NS=1,NSED + DO K=1,KC + DO L=2,LA + SEDTLPF(L,K)=SEDTLPF(L,K)+SEDLPF(L,K,NS) + ENDDO + ENDDO + ENDDO + IF(ISRSPH(6).EQ.1.AND.ISTRAN(6).GE.1)THEN + DO NSC=1,NSED + CALL RSALPLTH(6,SEDTLPF) + ENDDO + ENDIF + DO NS=1,NSND + DO K=1,KB + DO L=2,LA + SNDBTLPF(L,K)=SNDBTLPF(L,K)+SNDBLPF(L,K,NS) + ENDDO + ENDDO + ENDDO + DO NS=1,NSND + DO K=1,KC + DO L=2,LA + SNDTLPF(L,K)=SNDTLPF(L,K)+SNDLPF(L,K,NS) + ENDDO + ENDDO + ENDDO + IF(ISRSPH(7).EQ.1.AND.ISTRAN(7).GE.1)THEN + DO NSN=1,NSND + CALL RSALPLTH(7,SNDTLPF) + ENDDO + ENDIF +C +C ** RESIDUAL VELOCITY VECTOR PLOTTING IN HORIZONTAL PLANES: +C ** SUBROUTINE RVELPLTH +C + IF(ISRVPH.GE.1) CALL RVELPLTH +C +C ** RESIDUAL SURFACE ELEVATION PLOTTING IN HORIZONTAL PLANES: +C ** SUBROUTINE RVELPLTH +C + IF(ISRPPH.EQ.1) CALL RSURFPLT +C +C ** RESIDUAL SALINITY AND VERTICAL MASS DIFFUSIVITY CONTOURING IN +C ** 3 VERTICAL PLANES: SUBROUTINE RSALPLTV +C + DO ITMP=1,7 + IF(ISRSPV(ITMP).GE.1) CALL RSALPLTV(ITMP) + ENDDO +C +C ** RESIDUAL NORMAL AND TANGENTIAL VELOCITY CONTOURING AND AND +C ** TANGENTIAL VELOCITY VECTOR PLOTTING IN VERTICAL PLANES: +C ** SUBROUTINE RVELPLTV +C + IF(ISRVPV.GE.1) CALL RVELPLTV +C +C ** RESIDUAL 3D SCALAR AND VECTOR OUTPUT FILES +C + IF(ISR3DO.GE.1) CALL ROUT3D + 199 CONTINUE + NMMT=0 + 200 CONTINUE + IF(ISICM.GE.1)THEN + NMMT=NMMT+2 + ELSE + NMMT=NMMT+1 + ENDIF + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for new file mode 100644 index 000000000..63e084bc4 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for @@ -0,0 +1,209 @@ + SUBROUTINE CALPNHS_mpi +C +C CHANGE RECORD +C ** SUBROUTINE CALPNHS CALCULATES QUASI-NONHYDROSTATIC PRESSURE +C + USE GLOBAL + USE MPI + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::PNHYDSS + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FWJET + IF(.NOT.ALLOCATED(PNHYDSS))THEN + ALLOCATE(PNHYDSS(LCM,KCM)) + ALLOCATE(FWJET(LCM,KCM)) + PNHYDSS=0.0 + FWJET=0.0 + ENDIF +C + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + DELTD2=0.5*DT + DELTI=1./DELT + ELSE + DELT=DTDYN + DELTD2=0.5*DTDYN + DELTI=1./DELT + END IF + IF(N.EQ.1)THEN + DO K=0,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WZ1(L,K)=0. + FWJET(L,K)=0. ! *** DSLLC + ENDDO + ENDDO + ENDIF +C +C ** CALCULATE THE PHYSICAL VERTICAL VELOCIY +C + IF(NPROCS.GT.1)THEN +C CALL BROADCAST_BOUNDARY(P,IC) + CALL BROADCAST_BOUNDARY(DXIU,IC) + CALL BROADCAST_BOUNDARY(DYIV,IC) +C CALL BROADCAST_BOUNDARY_ARRAY(U,IC) +C CALL BROADCAST_BOUNDARY_ARRAY(V,IC) + ENDIF +C +!$OMP PARALLEL DO PRIVATE(LN,LS) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + WZ(L,0)=DELTI*(BELV(L)-BELV1(L)) + WZ(L,KC)=GI*( DELTI*(P(L)-P1(L)) + & +0.5*U(L+1,KC)*(P(L+1)-P(L))*DXIU(L+1) + & +0.5*U(L,KC)*(P(L)-P(L-1))*DXIU(L) + & +0.5*V(LN,KC)*(P(LN)-P(L))*DYIV(LN) + & +0.5*V(L,KC)*(P(L)-P(LS))*DYIV(L) ) + ENDDO + IF(KC.GT.2)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + WZ(L,K)=W(L,K)+GI*ZZ(K)*( DELTI*(P(L)-P1(L)) + & +0.5*U(L+1,K)*(P(L+1)-P(L))*DXIU(L+1) + & +0.5*U(L,K)*(P(L)-P(L-1))*DXIU(L) + & +0.5*V(LN,K)*(P(LN)-P(L))*DYIV(LN) + & +0.5*V(L,K)*(P(L)-P(LS))*DYIV(L) ) + & +(1.-ZZ(K))*( DELTI*(BELV(L)-BELV1(L)) + & +0.5*U(L+1,K)*(BELV(L+1)-BELV(L))*DXIU(L+1) + & +0.5*U(L,K)*(BELV(L)-BELV(L-1))*DXIU(L) + & +0.5*V(LN,K)*(BELV(LN)-BELV(L))*DYIV(LN) + & +0.5*V(L,K)*(BELV(L)-BELV(LS))*DYIV(L) ) + ENDDO + ENDDO + ENDIF +C + IF(NPROCS.GT.1)THEN + CALL BROADCAST_BOUNDARY_ARRAY(WZ,IC) + ENDIF +C ** CALCULATE FLUXES +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + PNHYDSS(L,K)=PNHYDS(L,K) + FUHU(L,K)=0. + FVHU(L,K)=0. + FWQQ(L,KC)=0. + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + UHUW=0.5*(UHDY(L,K)+UHDY(L,K+1)) + VHVW=0.5*(VHDX(L,K)+VHDX(L,K+1)) + FUHU(L,K)=MAX(UHUW,0.)*WZ(L-1,K) + & +MIN(UHUW,0.)*WZ(L,K) + FVHU(L,K)=MAX(VHVW,0.)*WZ(LS,K) + & +MIN(VHVW,0.)*WZ(L,K) + ENDDO + ENDDO + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(WB) + DO L=LMPI2,LMPILA + WB=0.5*DXYP(L)*(W(L,K-1)+W(L,K)) + FWQQ(L,K)=MAX(WB,0.)*WZ(L,K-1) + & +MIN(WB,0.)*WZ(L,K) + FWJET(L,K)=0. + ENDDO + ENDDO +C +C ** ADD RETURN FLOW MOMENTUM FLUX +C + DO NWR=1,NQWR + IF(NQWRMFU(NWR).GT.0)THEN + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + LU=LIJ(IU,JU) + NS=NQWRSERQ(NWR) + QMF=QWR(NWR)+QWRSERT(NS) + QUMF=QMF*QMF/(H1P(LU)*DZC(KU)*BQWRMFU(NWR)) + IF(NQWRMFU(NWR).EQ.1) FWJET(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.2) FWJET(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.3) FWJET(LU+1 ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.4) FWJET(LNC(LU),KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-1) FWJET(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-2) FWJET(LU ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-3) FWJET(LU+1 ,KU)=-QUMF + IF(NQWRMFU(NWR).EQ.-4) FWJET(LNC(LU),KU)=-QUMF + ENDIF + IF(NQWRMFD(NWR).GT.0)THEN + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LD=LIJ(ID,JD) + ADIFF=ABS(ANGWRMFD(NWR)-90.) + IF(ADIFF.LT.1.0)THEN + TMPANG=1. + ELSE + TMPANG=0.017453*ANGWRMFD(NWR) + TMPANG=SIN(TMPANG) + ENDIF + NS=NQWRSERQ(NWR) + QMF=QWR(NWR)+QWRSERT(NS) + QUMF=TMPANG*QMF*QMF/(H1P(LD)*DZC(KD)*BQWRMFD(NWR)) + IF(NQWRMFD(NWR).EQ.1) FWJET(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.2) FWJET(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.3) FWJET(LD+1 ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.4) FWJET(LNC(LD),KD)=QUMF + IF(NQWRMFD(NWR).EQ.-1) FWJET(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-2) FWJET(LD ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-3) FWJET(LD+1 ,KD)=QUMF + IF(NQWRMFD(NWR).EQ.-4) FWJET(LNC(LD),KD)=QUMF + ENDIF + ENDDO +C +C ** CALCULATE QUASI-NONHYDROSTATIC PRESSURE +C +!$OMP PARALLEL DO PRIVATE(LN,TMPVAL) + DO L=LMPI2,LMPILA + LN=LNC(L) + TMPVAL=0.5*DZC(KC)/DXYP(L) + PNHYDS(L,KC)= 0.75*TMPVAL*( + & DELTI*DXYP(L)*(HP(L)*WZ(L,KC)-H1P(L)*WZ1(L,KC)) + & +FUHU(L+1,KC)-FUHU(L,KC)+FVHU(LN,KC)-FVHU(L,KC) ) + & +0.25*TMPVAL*( + & DELTI*DXYP(L)*(HP(L)*WZ(L,KS)-H1P(L)*WZ1(L,KS)) + & +FUHU(L+1,KS)-FUHU(L,KS)+FVHU(LN,KS)-FVHU(L,KS) ) + & -FWQQ(L,KC) + ENDDO + DO K=KS,1,-1 +!$OMP PARALLEL DO PRIVATE(LN,TMPVAL) + DO L=LMPI2,LMPILA + LN=LNC(L) + TMPVAL=0.5*(DZC(K+1)+DZC(K))/DXYP(L) + PNHYDS(L,K)=PNHYDS(L,K+1)+FWQQ(L,K+1)-FWQQ(L,K)-FWJET(L,K) + & +TMPVAL*( DELTI*DXYP(L)*(HP(L)*WZ(L,K)-H1P(L)*WZ1(L,K)) + & +FUHU(L+1,K)-FUHU(L,K)+FVHU(LN,K)-FVHU(L,K) ) + ENDDO + ENDDO + DO K=0,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WZ1(L,K)=WZ(L,K) + ENDDO + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + PNHYDS(L,K)=0.5*(PNHYDSS(L,K)+PNHYDS(L,K)) + ENDDO + ENDDO + IF(N.EQ.2.AND.DEBUG)THEN +!####!!! COLLECT_ZERO_ARRAY(PHNYDS) + IF(MYRANK.EQ.0)THEN + OPEN(1,FILE='PNHYDS.DIA') + DO L=2,LA + WRITE(1,888)IL(L),JL(L),(PNHYDS(L,K),K=1,KC) + ENDDO + CLOSE(1) + ENDIF + ENDIF + 888 FORMAT(2I5,10E14.5) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for new file mode 100644 index 000000000..c86db1c9a --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for @@ -0,0 +1,39 @@ + SUBROUTINE CALPSER_mpi (ISTL_) +C +C CHANGE RECORD +C ** SUBROUTINE CALPSER UPDATES TIME VARIABLE SURFACE ELEVATION +C ** BOUNDARY CONDITIONS +C + USE GLOBAL + USE MPI +C + S1TIME=MPI_TIC() +C + PSERT(0)=0. + DO NS=1,NPSER + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)/TCPSER(NS)+TBEGIN*(TCON/TCPSER(NS)) + ELSE + TIME=TIMESEC/TCPSER(NS) + ENDIF + M1=MPTLAST(NS) + 100 CONTINUE + M2=M1+1 + IF(TIME.GT.TPSER(M2,NS))THEN + M1=M2 + GOTO 100 + ELSE + MPTLAST(NS)=M1 + ENDIF + TDIFF=TPSER(M2,NS)-TPSER(M1,NS) + WTM1=(TPSER(M2,NS)-TIME)/TDIFF + WTM2=(TIME-TPSER(M1,NS))/TDIFF + PSERT(NS)=WTM1*PSER(M1,NS)+WTM2*PSER(M2,NS) + ENDDO +C + MPI_WTIMES(1214)=MPI_WTIMES(1214)+MPI_TOC(S1TIME) +C +C6000 FORMAT('N, PSERT = ',I6,4X,F12.4) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for new file mode 100644 index 000000000..c62819998 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for @@ -0,0 +1,1485 @@ + SUBROUTINE CALPUV2C_mpi +C +C ** PREVIOUS NAME WAS CALPUV2TC +C CHANGE RECORD +C MODIFIED DRYING AND WETTING SCHEME. THE OLD FORMULATION REMAINS +C SEE (ISDRY.GT.0.AND.ISDRY.LT.98). THE NEW FORMULATION IS ACTIVATED +C BY (ISDRY.EQ.99). ALSO ADDED OPTION TO WASTE WATER FROM ESSENTIALLY +C DRY CELLS HAVING WATER DEPTHS GREATER THAN HDRY. IE THE HIGH AND +C WET CELLS BLOCKED BY DRY CELLS. THIS IS ACTIVED BY A NEGATIVE VALUE +C OF NDRYSTP PARAMETER IS THE EFDC.INP FILE +C ADDED SAVE OF OLD VALUES OF HORIZONTAL FLOW FACE SWITCHES SUB1 & SVB1 +C AND TRANSPORT BYPASS MASK, IMASKDRY FOR DRY CELLS. ADD VARIABLE +C IDRYDWN TO MARK WASTING FROM BLOCKED CELLS +C ADDED QDWASTE(L) TO SAVE SOURCE EQUIVALENT OF VOLUME LOSS RATE +C FOR REDUCING DEPTH OF HIGH/DRY CELLS. ALSO ADDED CONCENTRATION +C ADJUSTMENT +C ** SUBROUTINE CALPUV2TC CALCULATES THE EXTERNAL SOLUTION FOR P, UHDYE, +C ** AND VHDXE, FOR FREE SURFACE FLOWS WITH PROVISIONS FOR WETTING +C ** AND DRYING OF CELLS +C + USE GLOBAL + USE MPI + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IACTIVE + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IQDRYDWN + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANUT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANVT + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QSUMTMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SUB1 + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVB1 + INTEGER LMPI2IC + INTEGER CHECK_DRY + INTEGER LMIN,LMAX,L + L=0 + LMIN=0 + LMAX=0 + IF(.NOT.ALLOCATED(IACTIVE))THEN + ALLOCATE(IACTIVE(NCHANM)) + ALLOCATE(IQDRYDWN(LCM)) + ALLOCATE(QCHANUT(NCHANM)) + ALLOCATE(QCHANVT(NCHANM)) + ALLOCATE(QSUMTMP(LCM)) + ALLOCATE(SUB1(LCM)) + ALLOCATE(SVB1(LCM)) + IACTIVE=0 + IQDRYDWN=0 + QCHANUT=0. + QCHANVT=0. + QSUMTMP=0. + SUB1=0. + SVB1=0. + ENDIF +C + IF(MYRANK.EQ.0.AND.N.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='MODCHAN.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + IF(MYRANK.EQ.0.AND.N.EQ.1.AND.ISDSOLV.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='FUV1.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQCOEF1.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQTERM1.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='FP1.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + IF(MYRANK.EQ.0.AND.N.EQ.2.AND.ISDSOLV.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='FUV2.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQCOEF2.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQTERM2.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='FP2.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + IF(MYRANK.EQ.0.AND.ISDSOLV.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='FUV.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQCOEF.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='EQTERM.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='FP.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + DELTD2=0.5*DT + DELTI=1./DELT + ELSE + DELT=DTDYN + DELTD2=0.5*DTDYN + DELTI=1./DELT + ENDIF + ISTL=2 + RLAMN=QCHERR + RLAMO=1.-RLAMN +C +C ** SET SWITCHES FOR DRYING AND WETTING +C + ITERHP=0 + NCORDRY=0 + ICORDRY=0 + NEWDRY=0 + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + IQDRYDWN(L)=0 + ISCDRY(L)=0 + ENDDO +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SUB1(L)=SUB(L) + SVB1(L)=SVB(L) + ENDDO + MPI_WTIMES(201)=MPI_WTIMES(201)+MPI_TOC(S1TIME) +C +C ** INITIALIZE SUBGRID SCALE CHANNEL INTERACTIONS +C + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + QCHANUT(NMD)=QCHANU(NMD) + QCHANVT(NMD)=QCHANV(NMD) + ENDDO + ENDIF +C +C ** CALCULATE EXTERNAL BUOYANCY INTEGRALS AT TIME LEVEL (N) +C + IF(BSC.GT.1.E-6)THEN + CALL CALEBI_mpi +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FPGXE(L)=-SBX(L)*HU(L)*GP*((BI2(L)+BI2(L-1))*(HP(L)-HP(L-1)) + & +2.0*HU(L)*(BI1(L)-BI1(L-1)) + & +(BE(L)+BE(L-1))*(BELV(L)-BELV(L-1))) + ENDDO +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FPGYE(L)=-SBY(L)*HV(L)*GP*((BI2(L)+BI2(LS))*(HP(L)-HP(LS)) + & +2.0*HV(L)*(BI1(L)-BI1(LS)) + & +(BE(L)+BE(LS))*(BELV(L)-BELV(LS))) + ENDDO + MPI_WTIMES(202)=MPI_WTIMES(202)+MPI_TOC(S1TIME) + ENDIF +C + IF(.FALSE.)THEN + call collect_in_zero(FPGXE) + call collect_in_zero(FPGYE) + call collect_in_zero(SBX ) + call collect_in_zero(SBY ) + call collect_in_zero(HU ) + call collect_in_zero(HV ) + call collect_in_zero(HP ) + call collect_in_zero(BI1 ) + call collect_in_zero(BI2 ) + call collect_in_zero(BE ) + call collect_in_zero(BELV ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'FPGXE = ', sum(abs(dble(FPGXE))) + PRINT*, n,'FPGYE = ', sum(abs(dble(FPGYE))) + PRINT*, n,'SBX = ', sum(abs(dble(SBX ))) + PRINT*, n,'SBY = ', sum(abs(dble(SBY ))) + PRINT*, n,'HU = ', sum(abs(dble(HU ))) + PRINT*, n,'HV = ', sum(abs(dble(HV ))) + PRINT*, n,'HP = ', sum(abs(dble(HP ))) + PRINT*, n,'BI1 = ', sum(abs(dble(BI1 ))) + PRINT*, n,'BI2 = ', sum(abs(dble(BI2 ))) + PRINT*, n,'BE = ', sum(abs(dble(BE ))) + PRINT*, n,'BELV = ', sum(abs(dble(BELV ))) + ENDIF + ENDIF +C ** CALCULATE EXPLICIT EXTERNAL UHDYE AND VHDXE EQUATION TERMS +C ** HRU=SUB*HMU*DYU/DXU & HRV=SVB*HMV*DXV/DYV +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + H2P(L)=HP(L) + ENDDO +C +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FUHDYE(L)=UHDYE(L) + & -DELTD2*SUB(L)*HRUO(L)*HU(L)*(P(L)-P(L-1)) + & +SUB(L)*DELT*DXIU(L)*(DXYU(L)*(TSX(L)-RITB1*TBX(L)) + & +FCAXE(L)+FPGXE(L)-SNLT*FXE(L)) +C + FVHDXE(L)=VHDXE(L) + & -DELTD2*SVB(L)*HRVO(L)*HV(L)*(P(L)-P(LS)) + & +SVB(L)*DELT*DYIV(L)*(DXYV(L)*(TSY(L)-RITB1*TBY(L)) + & -FCAYE(L)+FPGYE(L)-SNLT*FYE(L)) + ENDDO + MPI_WTIMES(203)=MPI_WTIMES(203)+MPI_TOC(S1TIME) +C + IF(ISDSOLV.GE.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='FUV.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),UHDY1E(L),HRUO(L),HU(L),P1(L), + & P1(L-1),TSX1(L),TBX1(L),FCAXE(L),FPGXE(L),FXE(L) + ENDDO + CLOSE(1) + IF(N.EQ.1)THEN + OPEN(1,FILE='FUV1.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),UHDY1E(L),HRUO(L),HU(L),P1(L), + & P1(L-1),TSX1(L),TBX1(L),FCAXE(L),FPGXE(L),FXE(L) + ENDDO + CLOSE(1) + ENDIF + IF(N.EQ.2)THEN + OPEN(1,FILE='FUV2.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),UHDY1E(L),HRUO(L),HU(L),P1(L), + & P1(L-1),TSX1(L),TBX1(L),FCAXE(L),FPGXE(L),FXE(L) + ENDDO + CLOSE(1) + ENDIF + ENDIF +C +C ** SET IMPLICIT BOTTOM AND VEGETATION DRAG AS APPROPRIATE +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=1. + RCY(L)=1. + ENDDO + MPI_WTIMES(204)=MPI_WTIMES(204)+MPI_TOC(S1TIME) + + RCX(1)=0. + RCY(1)=0. + RCX(LC)=0. + RCY(LC)=0. +C +C * SINGLE LAYER NO VEGETATION +C + IF(KC.EQ.1)THEN + IF(ISVEG.EQ.0.AND.RITB.GT.0.)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=1./( 1. + & +RITB*DELT*HUI(L)*STBX(L)*SQRT(VU(L)*VU(L)+U(L,1)*U(L,1))) + RCY(L)=1./( 1. + & +RITB*DELT*HVI(L)*STBY(L)*SQRT(UV(L)*UV(L)+V(L,1)*V(L,1))) + FUHDYE(L)=FUHDYE(L)*RCX(L) + FVHDXE(L)=FVHDXE(L)*RCY(L) + ENDDO + MPI_WTIMES(205)=MPI_WTIMES(205)+MPI_TOC(S1TIME) + ENDIF +C +C * SINGLE LAYER WITH VEGETATION +C + IF(ISVEG.GE.1)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=1./( 1. + & +RITB*DELT*HUI(L)*STBX(L)*SQRT(VU(L)*VU(L)+U(L,1)*U(L,1)) + & +DELT*FXVEGE(L) ) + RCY(L)=1./( 1. + & +RITB*DELT*HVI(L)*STBY(L)*SQRT(UV(L)*UV(L)+V(L,1)*V(L,1)) + & +DELT*FYVEGE(L) ) + FUHDYE(L)=FUHDYE(L)*RCX(L) + FVHDXE(L)=FVHDXE(L)*RCY(L) + ENDDO + MPI_WTIMES(206)=MPI_WTIMES(206)+MPI_TOC(S1TIME) + ENDIF + ENDIF +C +C * MULTIPLE LAYERS WITH VEGETATION +C + IF(KC.GT.1.AND.ISVEG.GE.1)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=1./( 1.+DELT*FXVEGE(L) ) + RCY(L)=1./( 1.+DELT*FYVEGE(L) ) + FUHDYE(L)=FUHDYE(L)*RCX(L) + FVHDXE(L)=FVHDXE(L)*RCY(L) + ENDDO + MPI_WTIMES(207)=MPI_WTIMES(207)+MPI_TOC(S1TIME) + ENDIF +C +C ** RESET BOUNDARY CONDITIONS SWITCHES +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SUB(L)=SUBO(L) + SVB(L)=SVBO(L) + SBX(L)=SBXO(L) + SBY(L)=SBYO(L) + SUB(L+1)=SUBO(L+1) + SBX(L+1)=SBXO(L+1) + ENDDO + MPI_WTIMES(208)=MPI_WTIMES(208)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + SVB(LN)=SVBO(LN) + SBY(LN)=SBYO(LN) + ENDDO + MPI_WTIMES(209)=MPI_WTIMES(209)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(RCX,ic) + CALL broadcast_boundary(RCY,ic) + CALL broadcast_boundary(HRUO,ic) + CALL broadcast_boundary(HRVO,ic) + CALL broadcast_boundary(FUHDYE,ic) + CALL broadcast_boundary(FVHDXE,ic) + CALL broadcast_boundary_lbm(SUB,ic) + CALL broadcast_boundary_lbm(SVB,ic) + CALL broadcast_boundary_lbm(SBX,ic) + CALL broadcast_boundary_lbm(SBY,ic) + MPI_WTIMES(249)=MPI_WTIMES(249)+MPI_TOC(S1TIME) +C + IF(.FALSE.)THEN + call collect_in_zero(RCX ) + call collect_in_zero(RCY ) + call collect_in_zero(HRUO ) + call collect_in_zero(HRVO ) + call collect_in_zero(FUHDYE ) + call collect_in_zero(FVHDXE ) + call COLLECT_IN_ZERO_LBM(SUB ) + call COLLECT_IN_ZERO_LBM(SVB ) + call COLLECT_IN_ZERO_LBM(SBX ) + call COLLECT_IN_ZERO_LBM(SBY ) + call COLLECT_IN_ZERO_LBM(SUBO ) + call COLLECT_IN_ZERO_LBM(SVBO ) + call COLLECT_IN_ZERO_LBM(SBXO ) + call COLLECT_IN_ZERO_LBM(SBYO ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'RCX = ', sum(abs(dble(RCX ))) + PRINT*, n,'RCY = ', sum(abs(dble(RCY ))) + PRINT*, n,'HRUO = ', sum(abs(dble(HRUO ))) + PRINT*, n,'HRVO = ', sum(abs(dble(HRVO ))) + PRINT*, n,'FUHDYE = ', sum(abs(dble(FUHDYE))) + PRINT*, n,'FVHDXE = ', sum(abs(dble(FVHDXE))) + PRINT*, n,'SUB = ', sum(abs(dble(SUB ))) + PRINT*, n,'SVB = ', sum(abs(dble(SVB ))) + PRINT*, n,'SBX = ', sum(abs(dble(SBX ))) + PRINT*, n,'SBY = ', sum(abs(dble(SBY ))) + PRINT*, n,'SUBO = ', sum(abs(dble(SUBO ))) + PRINT*, n,'SVBO = ', sum(abs(dble(SVBO ))) + PRINT*, n,'SBXO = ', sum(abs(dble(SBXO ))) + PRINT*, n,'SBYO = ', sum(abs(dble(SBYO ))) + ENDIF + ENDIF +C ** ADJUST VOLUME SOURCE AND SINKS +C + IF(ISGWIE.EQ.0)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(QSUME(L).LE.0.)THEN + IF(H1P(L).LE.HDRY)THEN + QSUMTMP(L)=0. + ELSE + QSUMTMP(L)=-(H1P(L)-HDRY)*DXYP(L)*DELTI + QSUMTMP(L)=MAX(QSUMTMP(L),QSUME(L)) + ENDIF + ELSE + QSUMTMP(L)=QSUME(L) + ENDIF + ENDDO +!$OMP PARALLEL DO PRIVATE(DIFQVOL) + DO L=LMPI2,LMPILA + DIFQVOL=QSUME(L)-QSUMTMP(L) + DO K=1,KC + QSUM(L,K)=QSUM(L,K)-DIFQVOL*DZC(K) + ENDDO + QSUME(L)=QSUMTMP(L) + ENDDO + MPI_WTIMES(210)=MPI_WTIMES(210)+MPI_TOC(S1TIME) + ENDIF +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(QSUME,ic) + CALL broadcast_boundary_array(QSUM,ic) + MPI_WTIMES(250)=MPI_WTIMES(250)+MPI_TOC(S1TIME) +C +C ** ADJUST SOURCES AND SINKS ESTIMATING SURFACE AND GROUNDWATER +C ** AVAILABLE FOR EVAPOTRANSPIRATON AND INFILTRATION +C + IF(ISGWIE.GE.1)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(SVPW,DTAGW,RIFTRL,RAVAIL,QSUMIET,QEAVAIL) + DO L=LMPI2,LMPILA + RIFTR(L)=0. + EVAPSW(L)=0. + EVAPGW(L)=0. + IF(H1P(L).GT.HDRY)THEN +C APPLY MAXIMUM ET + IF(EVAPCVT.LT.0.)THEN + SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ + & (1.+0.00412*TEM(L,KC)))) + EVAPT(L)=CLEVAP(L)*0.7464E-3*WINDST(L)*(SVPW-VPA(L)) + & /PATMT(L) + ENDIF + EVAPSW(L)=EVAPT(L)*DXYP(L) + RIFTR(L)=0. +C CALCULATE DEPTH OF ACTIVE GROUNDWATER ELEV BELOW SURFACE + DTAGW=BELV(L)-AGWELV(L) + IF(DTAGW.GT.0.0)THEN +C INFLITRATION CAN OCCUR, CALCULATE LIMITING RATE TO BRING +C GW ELEV TO SOIL SURFACE + RIFTRL=RNPOR*DTAGW*DELTI +C SET RIFTRL TO MIN OF LIMITING RATE OR ACTUAL RATE + RIFTRL=MIN(RIFTRM,RIFTRL) +C ESTIMATE RATE BASED ON AVAILABLE SURFACE WATER + RAVAIL=(H1P(L)-HDRY)*DELTI-EVAPT(L) +C SET RIFTRL TO MIN OF AVAILABLE RATE OR LIMITING RATE + RIFTRL=MIN(RAVAIL,RIFTRL) +C CONVERT TO VOLUME FLOW UNITS + RIFTR(L)=RIFTRL*DXYP(L) + ENDIF +C ADJUST VOLUME OUTFLOWS OF WET CELLS + IF(QSUME(L).LT.0.0)THEN + QSUMIET=RIFTR(L)+EVAPSW(L) + QEAVAIL=DXYP(L)*(H1P(L)-HDRY)*DELTI-QSUMIET + QEAVAIL=MAX(QEAVAIL,0.0) + QEAVAIL=-QEAVAIL + QSUMTMP(L)=MAX(QSUME(L),QEAVAIL) + ELSE + QSUMTMP(L)=QSUME(L) + ENDIF + ELSE + RIFTR(L)=0. + EVAPSW(L)=0. + QSUMTMP(L)=MAX(QSUME(L),0.0) + ENDIF + ENDDO + MPI_WTIMES(211)=MPI_WTIMES(211)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(DIFQVOL) + DO L=LMPI2,LMPILA + DIFQVOL=QSUME(L)-QSUMTMP(L) + DO K=1,KC + QSUM(L,K)=QSUM(L,K)-DIFQVOL*DZC(K) + ENDDO + QSUME(L)=QSUMTMP(L) + ENDDO + MPI_WTIMES(212)=MPI_WTIMES(212)+MPI_TOC(S1TIME) + ENDIF +C +C ** ADVANCE EXTERNAL VARIABLES +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY1E(L)=UHDYE(L) + VHDX1E(L)=VHDXE(L) + P1(L)=P(L) + H1U(L)=HU(L) + H1V(L)=HV(L) + H1UI(L)=HUI(L) + H1VI(L)=HVI(L) + H1P(L)=HP(L) + ENDDO + MPI_WTIMES(213)=MPI_WTIMES(213)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary(UHDY1E,ic) + CALL broadcast_boundary(VHDX1E,ic) + CALL broadcast_boundary(P1,ic) + CALL broadcast_boundary(H1P,ic) + MPI_WTIMES(251)=MPI_WTIMES(251)+MPI_TOC(S1TIME) + +C + IF(ISGWIE.GE.1)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV2(L)=AGWELV1(L) + AGWELV1(L)=AGWELV(L) + ENDDO + MPI_WTIMES(214)=MPI_WTIMES(214)+MPI_TOC(S1TIME) + ENDIF +C +C ** SET OLD TIME LEVEL TERMS IN CONTINUITY EQUATION FOR NON BOUNDARY POINTS +C ** HRU=HMU*DYU/DXU & HRV=HMV*DXV/DYV +C ** DXYIP=1/(DXP*DYP) +C +C *** DSLLC BEGIN BLOCK + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + FP1(L)=DELTI*DXYP(L)*P(L)-0.5*G*(UHDYE(L+1)-UHDYE(L) + & +VHDXE(LN )-VHDXE(L)) + ENDDO + MPI_WTIMES(215)=MPI_WTIMES(215)+MPI_TOC(S1TIME) +C +C ** SET NEW TIME LEVEL TERMS IN CONTINUITY EQUATION INCLUDING +C ** HOST-GUEST CHANNAL INTERACTION FOR NON BOUNDARY POINTS +C ** REENTER AT 1000 FOR WETTING-DRYING CORRECTION AND CHANNEL +C ** INTERACTION +C + CHECK_DRY=0 + 1000 CONTINUE + CHECK_DRY=CHECK_DRY+1 + C1=0.5*G + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + FP(L)=FP1(L)-C1*(FUHDYE(L+1)-FUHDYE(L) + & +FVHDXE(LN )-FVHDXE(L) + & -2.0*QSUME(L) ) + ENDDO + MPI_WTIMES(216)=MPI_WTIMES(216)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(ISGWIE.GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FP(L)=FP(L)-G*SPB(L)*(RIFTR(L)+EVAPSW(L)) + ENDDO + ENDIF + MPI_WTIMES(217)=MPI_WTIMES(217)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + C1=-0.5*DELTD2*G +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CS(L)=C1*SVB(L )*HRVO(L )*RCY(L )*HV(L ) + CW(L)=C1*SUB(L )*HRUO(L )*RCX(L )*HU(L ) + CE(L)=C1*SUB(L+1)*HRUO(L+1)*RCX(L+1)*HU(L+1) + ENDDO +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + CN(L)=C1*SVB(LN )*HRVO(LN )*RCY(LN )*HV(LN ) + ENDDO + MPI_WTIMES(218)=MPI_WTIMES(218)+MPI_TOC(S1TIME) +C + IF(.FALSE.)THEN + call COLLECT_IN_ZERO_LBM(SVB ) + call collect_in_zero(HRVO ) + call collect_in_zero(RCY ) + call collect_in_zero(HV ) + call collect_in_zero(CS ) + call collect_in_zero(CW ) + call collect_in_zero(CE ) + call collect_in_zero(CN ) + call collect_in_zero(CC ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'SVB2 = ', sum(abs(dble(SVB ))) + PRINT*, n,'HRVO2 = ', sum(abs(dble(HRVO))) + PRINT*, n,'RCY2 = ', sum(abs(dble(RCY ))) + PRINT*, n,'HV2 = ', sum(abs(dble(HV ))) + PRINT*, n,'CS2 = ', sum(abs(dble(CS ))) + PRINT*, n,'CW2 = ', sum(abs(dble(CW ))) + PRINT*, n,'CE2 = ', sum(abs(dble(CE ))) + PRINT*, n,'CN2 = ', sum(abs(dble(CN ))) + PRINT*, n,'CC2 = ', sum(abs(dble(CC ))) + ENDIF + ENDIF +C *** APPLY THE OPEN BOUNDARY CONDITIONS +C +C IF(MYRANK.EQ.0) PRINT*,'SETOPENBC',NBCSOP + IF(NBCSOP.GT.0) CALL SETOPENBC(DELT,DELTD2,DELTI,HU,HV) +C + ! *** SET THE CENTER + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CC(L)=DELTI*DXYP(L)-CS(L)-CW(L)-CE(L)-CN(L) + ENDDO + MPI_WTIMES(219)=MPI_WTIMES(219)+MPI_TOC(S1TIME) +C + IF(.FALSE.)THEN + call collect_in_zero(CS ) + call collect_in_zero(CW ) + call collect_in_zero(CE ) + call collect_in_zero(CN ) + call collect_in_zero(CC ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'CS3 = ', sum(abs(dble(CS ))) + PRINT*, n,'CW3 = ', sum(abs(dble(CW ))) + PRINT*, n,'CE3 = ', sum(abs(dble(CE ))) + PRINT*, n,'CN3 = ', sum(abs(dble(CN ))) + PRINT*, n,'CC3 = ', sum(abs(dble(CC ))) + ENDIF + ENDIF +C ** INSERT IMPLICT SUB-GRID SCALE CHANNEL INTERACTIONS +C +C IF(MYRANK.EQ.0) PRINT*,'SUBCHAN',MDCHH + IF(MDCHH.GE.1)CALL SUBCHAN(QCHANUT,QCHANVT,IACTIVE,RLAMN,RLAMO, + & DELT,IACTALL) +C + ! *** SCALE COEFFICIENTS IN EXTERNAL MODEL LINEAR EQUATION SYSTEM + S1TIME=MPI_TIC() + CCMNM=1.E+18 +!$OMP PARALLEL DO REDUCTION(MIN:CCMNM) + DO L=LMPI2,LMPILA + CCMNM=MIN(CCMNM,CC(L)) + FPTMP(L)=FP(L) + ENDDO + CALL MPI_ALLREDUCE(CCMNM,MPI_R4,1,MPI_REAL,MPI_MIN,MPI_COMM_WORLD, + & IERR) + CCMNM=MPI_R4 + CCMNMI=1./CCMNM + MPI_WTIMES(220)=MPI_WTIMES(220)+MPI_TOC(S1TIME) + +C +C *** APPLY THE OPEN BOUNDARY CONDITIONS FOR ADJACENT CELLS +C +C IF(MYRANK.EQ.0) PRINT*,'SETOPENBC2',NBCSOP + IF(NBCSOP.GT.0) CALL SETOPENBC2 +C + S1TIME=MPI_TIC() + IF(ISDSOLV.GE.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='FP.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),FP1(L),FUHDYE(L),FUHDYE(L+1), + & FVHDXE(L),FVHDXE(LNC(L)),QSUME(L),RIFTR(L),EVAPSW(L) + ENDDO + CLOSE(1) + IF(N.EQ.1)THEN + OPEN(1,FILE='FP1.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),FP1(L),FUHDYE(L),FUHDYE(L+1), + & FVHDXE(L),FVHDXE(LNC(L)),QSUME(L),RIFTR(L),EVAPSW(L) + ENDDO + CLOSE(1) + ENDIF + IF(N.EQ.2)THEN + OPEN(1,FILE='FP2.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),FP1(L),FUHDYE(L),FUHDYE(L+1), + & FVHDXE(L),FVHDXE(LNC(L)),QSUME(L),RIFTR(L),EVAPSW(L) + ENDDO + CLOSE(1) + ENDIF + ENDIF + MPI_WTIMES(221)=MPI_WTIMES(221)+MPI_TOC(S1TIME) +C + CC(1)=1. + CC(LC)=1. +C +C ** SCALE BY MINIMUM DIAGONAL +C + S1TIME=MPI_TIC() + IF(IRVEC.EQ.9)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CCS(L)=CS(L)*CCMNMI + CCW(L)=CW(L)*CCMNMI + CCE(L)=CE(L)*CCMNMI + CCN(L)=CN(L)*CCMNMI + CCC(L)=CC(L)*CCMNMI + FPTMP(L)=FPTMP(L)*CCMNMI + CCCI(L)=1./CCC(L) + ENDDO + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + CCCCHH(NMD)=CCCCHH(NMD)*CCMNMI + ENDDO + ENDIF + ENDIF + MPI_WTIMES(222)=MPI_WTIMES(222)+MPI_TOC(S1TIME) +C +C ** CALL EQUATION SOLVER +C + IF(.FALSE.)THEN + call collect_in_zero(FPTMP) + call collect_in_zero(CCS ) + call collect_in_zero(CCW ) + call collect_in_zero(CCE ) + call collect_in_zero(CCN ) + call collect_in_zero(CCC ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'FPTMP = ', sum(abs(dble(FPTMP))) + PRINT*, n,'CCS = ', sum(abs(dble(CCS ))) + PRINT*, n,'CCW = ', sum(abs(dble(CCW ))) + PRINT*, n,'CCE = ', sum(abs(dble(CCE ))) + PRINT*, n,'CCN = ', sum(abs(dble(CCN ))) + PRINT*, n,'CCC = ', sum(abs(dble(CCC ))) + ENDIF + ENDIF + IF(MDCHH.EQ.0) CALL CONGRAD_mpi(ISTL) + !IF(MDCHH.EQ.0) CALL CONGRAD_mpi_real(ISTL) + IF(MDCHH.GE.1) CALL CONGRADC(ISTL) +C +C ** DIAGNOSTICS +C + S1TIME=MPI_TIC() + IF(ISDSOLV.GE.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='EQCOEF.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + SURFTMP=GI*P(L) + WRITE(1,1001)IL(L),JL(L),CS(L),CW(L),CC(L),CE(L),CN(L), + & FP(L),SURFTMP + ENDDO + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + WRITE(1,1001)NMD,MDCHTYP(NMD),CCCCHH(NMD),CCCCHU(NMD), + & CCCCHV(NMD),QCHANUT(NMD),QCHANVT(NMD) + ENDDO + ENDIF + CLOSE(1) + IF(N.EQ.1)THEN + OPEN(1,FILE='EQCOEF1.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + SURFTMP=GI*P(L) + WRITE(1,1001)IL(L),JL(L),CS(L),CW(L),CC(L),CE(L),CN(L), + & FP(L),SURFTMP + ENDDO + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + WRITE(1,1001)NMD,MDCHTYP(NMD),CCCCHH(NMD),CCCCHU(NMD), + & CCCCHV(NMD),QCHANUT(NMD),QCHANVT(NMD) + ENDDO + ENDIF + CLOSE(1) + ENDIF + IF(N.EQ.2)THEN + OPEN(1,FILE='EQCOEF2.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + SURFTMP=GI*P(L) + WRITE(1,1001)IL(L),JL(L),CS(L),CW(L),CC(L),CE(L),CN(L), + & FP(L),SURFTMP + ENDDO + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + WRITE(1,1001)NMD,MDCHTYP(NMD),CCCCHH(NMD),CCCCHU(NMD), + & CCCCHV(NMD),QCHANUT(NMD),QCHANVT(NMD) + ENDDO + ENDIF + CLOSE(1) + ENDIF + ENDIF + MPI_WTIMES(223)=MPI_WTIMES(223)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(ISDSOLV.GE.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='EQTERM.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),SUB(L),SVB(L),HRUO(L), + & HRVO(L),HU(L),HV(L) + ENDDO + CLOSE(1) + IF(N.EQ.1)THEN + OPEN(1,FILE='EQTERM1.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),SUB(L),SVB(L),HRUO(L), + & HRVO(L),HU(L),HV(L) + ENDDO + CLOSE(1) + ENDIF + IF(N.EQ.2)THEN + OPEN(1,FILE='EQTERM2.OUT',POSITION='APPEND',STATUS='UNKNOWN') + WRITE(1,1001)N,ISTL + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),SUB(L),SVB(L),HRUO(L), + & HRVO(L),HU(L),HV(L) + ENDDO + CLOSE(1) + ENDIF + ENDIF + MPI_WTIMES(224)=MPI_WTIMES(224)+MPI_TOC(S1TIME) + 1001 FORMAT(2I5,10(1X,E12.4)) +C1002 FORMAT(3I4,10(1X,E9.2)) +C +C ** CALCULATE UHEX AND VHEX AND TOTAL DEPTHS AT TIME LEVEL (N+1) +C ** HRU=SUB*DYU/DXU & HRV=SVB*DXV/DYV +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + UHDYE(L)=SUB(L)*( FUHDYE(L) + & -DELTD2*HRUO(L)*RCX(L)*HU(L)*(P(L)-P(L-1)) ) + VHDXE(L)=SVB(L)*( FVHDXE(L) + & -DELTD2*HRVO(L)*RCY(L)*HV(L)*(P(L)-P(LS )) ) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHE(L)=UHDYE(L)*DYIU(L) + VHE(L)=VHDXE(L)*DXIV(L) + ENDDO + MPI_WTIMES(225)=MPI_WTIMES(225)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(UHDYE,ic) + CALL broadcast_boundary(VHDXE,ic) + MPI_WTIMES(252)=MPI_WTIMES(252)+MPI_TOC(S1TIME) +C +C ** CALCULATE NEW SUB-GRID SCALE CHANNEL EXCHANGE FLOWS +C + S1TIME=MPI_TIC() + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + IF (IACTIVE(NMD).GT.0)THEN + LHOST=LMDCHH(NMD) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + QCHANU(NMD)=CCCCHU(NMD)*QCHANUT(NMD) + & -RLAMN*CCCCHU(NMD)*CCCCHV(NMD)*(P(LHOST)-P(LCHNU)) + & -RLAMO*CCCCHU(NMD)*CCCCHV(NMD)*(P1(LHOST)-P1(LCHNU)) + QCHANUN(NMD)=QCHANUT(NMD) + QCHANV(NMD)=0. + QCHANVN(NMD)=QCHANVT(NMD) + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + QCHANV(NMD)=CCCCHU(NMD)*QCHANVT(NMD) + & -RLAMN*CCCCHU(NMD)*CCCCHV(NMD)*(P(LHOST)-P(LCHNV)) + & -RLAMO*CCCCHU(NMD)*CCCCHV(NMD)*(P1(LHOST)-P1(LCHNV)) + QCHANVN(NMD)=QCHANVT(NMD) + QCHANU(NMD)=0. + QCHANUN(NMD)=QCHANUT(NMD) + ENDIF + ELSE + QCHANV(NMD)=0. + QCHANVN(NMD)=0. + QCHANU(NMD)=0. + QCHANUN(NMD)=0. + ENDIF + ENDDO + ENDIF + MPI_WTIMES(226)=MPI_WTIMES(226)+MPI_TOC(S1TIME) +C +C ** CALCULATE REVISED CELL DEPTHS BASED ON NEW HORIZONTAL +C ** TRANSPORTS AT (N+1) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + HP(L)=H1P(L)+DELTD2*DXYIP(L)*(2.*QSUME(L) !+QSUM1E(L) PMC + & -(UHDYE(L+1)+UHDY1E(L+1)-UHDYE(L)-UHDY1E(L) + & +VHDXE(LN) +VHDX1E(LN )-VHDXE(L)-VHDX1E(L))) + ENDDO + MPI_WTIMES(227)=MPI_WTIMES(227)+MPI_TOC(S1TIME) +C + IF(.FALSE.)THEN + call collect_in_zero(DXYIP ) + call collect_in_zero(QSUME ) + call collect_in_zero(UHDYE ) + call collect_in_zero(VHDXE ) + call collect_in_zero(H1P ) + call collect_in_zero(HP ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'DXYIP = ', sum(abs(dble(DXYIP))) + PRINT*, n,'QSUME = ', sum(abs(dble(QSUME))) + PRINT*, n,'UHDYE = ', sum(abs(dble(UHDYE))) + PRINT*, n,'VHDXE = ', sum(abs(dble(VHDXE))) + PRINT*, n,'H1P = ', sum(abs(dble(H1P ))) + PRINT*, n,'HP = ', sum(abs(dble(HP ))) + ENDIF + ENDIF + + S1TIME=MPI_TIC() + IF(ISGWIE.GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HP(L)=HP(L)-DELT*DXYIP(L)*(RIFTR(L)+EVAPSW(L)) + ENDDO + ENDIF + MPI_WTIMES(228)=MPI_WTIMES(228)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + ! *** APPLY OPEN BOUNDARYS + DO LL=1,NBCSOP + L=LOBCS(LL) + HP(L)=GI*P(L)-BELV(L) + ENDDO +C +C ** ADD CHANNEL INTERACTION EXCHANGES +C + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + IF(IACTIVE(NMD).GT.0)THEN + LHOST=LMDCHH(NMD) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + TMPVAL=DELT*(RLAMN*QCHANU(NMD)+RLAMO*QCHANUT(NMD)) + HP(LHOST)=HP(LHOST)+TMPVAL*DXYIP(LHOST) + HP(LCHNU)=HP(LCHNU)-TMPVAL*DXYIP(LCHNU) + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + TMPVAL=DELT*(RLAMN*QCHANV(NMD)+RLAMO*QCHANVT(NMD)) + HP(LHOST)=HP(LHOST)+TMPVAL*DXYIP(LHOST) + HP(LCHNV)=HP(LCHNV)-TMPVAL*DXYIP(LCHNV) + ENDIF + ENDIF + ENDDO + ENDIF + MPI_WTIMES(229)=MPI_WTIMES(229)+MPI_TOC(S1TIME) +C +C ** PERFORM INTERMEDIATE UPDATES OF P +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + P(L)=G*(HP(L)+BELV(L)) + ENDDO + MPI_WTIMES(230)=MPI_WTIMES(230)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(P,2*ic) + CALL broadcast_boundary(HP,2*ic) + MPI_WTIMES(253)=MPI_WTIMES(253)+MPI_TOC(S1TIME) +C +C ** CHECK FOR DRYING AND RESOLVE EQUATIONS IF NECESSARY +C +CGEO call collect_in_zero(HP ) +CGEO IF(MYRANK.EQ.0)THEN +CGEO PRINT*, n,'HP = ', sum(abs(dble(HP))) +CGEO ENDIF +C + IF(ISDRY.GT.0.AND.ISDRY.LT.98)THEN + S1TIME=MPI_TIC() + ICORDRY=0 + LMPI2IC=MAX(2,LMPI2-IC) + DO L=LMPI2IC,LMPILA + LS=LSC(L) + LN=LNC(L) + IF(HP(L).LE.HDRY)THEN + IF(ISCDRY(L).EQ.0)THEN + ISCDRY(L)=1 + ICORDRY=1 + ENDIF + SUB(L)=0. + SVB(L)=0. + SUB(L+1)=0. + SVB(LN)=0. + SBX(L)=0. + SBY(L)=0. + SBX(L+1)=0. + SBY(LN)=0. + ENDIF + ENDDO + MPI_WTIMES(231)=MPI_WTIMES(231)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_lbm(SUB,ic) + CALL broadcast_boundary_lbm(SVB,ic) + CALL broadcast_boundary_lbm(SBX,ic) + CALL broadcast_boundary_lbm(SBY,ic) + CALL MPI_ALLREDUCE(ICORDRY,MPI_I4,1,MPI_INTEGER, + & MPI_MAX,MPI_COMM_WORLD,IERR) + ICORDRY=MPI_I4 + MPI_WTIMES(254)=MPI_WTIMES(254)+MPI_TOC(S1TIME) +C +CGEO IF(MYRANK.EQ.0) PRINT*,N,1,ICORDRY + IF(ICORDRY.EQ.1)THEN + NCORDRY=NCORDRY+1 + GOTO 1000 + ENDIF + ENDIF +C6960 FORMAT(' NCORDRY =', I5) +C6961 FORMAT(' UNSTABLE, NCORDRY =', I5) +C9999 CONTINUE +C +C ** CHECK FOR DRYING AND RESOLVE EQUATIONS IF NECESSARY +C + CALL broadcast_boundary_lbm(SUB,ic) + CALL broadcast_boundary_lbm(SVB,ic) + CALL broadcast_boundary_lbm(SBX,ic) + CALL broadcast_boundary_lbm(SBY,ic) + CALL broadcast_boundary_lbm(SUBO,ic) + CALL broadcast_boundary_lbm(SVBO,ic) + S1TIME=MPI_TIC() + IF(ISDRY.EQ.99)THEN + HDRY2=2.*HDRY + ICORDRY=0 + LMPI2IC=MAX(2,LMPI2-IC) + DO L=LMPI2IC,LMPILA + LS=LSC(L) + LN=LNC(L) + IF(HP(L).LE.HDRY)THEN + SUBW=SUB(L) + SUBE=SUB(L+1) + SVBS=SVB(L) + SVBN=SVB(LN) + DHPDT=DELTI*(HP(L)-H1P(L)) + ! *** ALLOW RE-WETTING + IF(DHPDT.GT.0.0)THEN + SUB(L)=0.0 + SUB(L+1)=0.0 + SVB(L)=0.0 + SVB(LN)=0.0 + SBX(L)=0.0 + SBX(L+1)=0.0 + SBY(L)=0.0 + SBY(LN)=0.0 + IF(SUBO(L).GT.0.5)THEN + IF(UHDYE(L).GT.0.0.AND.HP(L-1).GT.HDRY2)THEN + SUB(L)=1. + SBX(L)=1. + ENDIF + ENDIF + IF(SUBO(L+1).GT.0.5)THEN + IF(UHDYE(L+1).LT.0.0.AND.HP(L+1).GT.HDRY2)THEN + SUB(L+1)=1. + SBX(L+1)=1. + ENDIF + ENDIF + IF(SVBO(L).GT.0.5)THEN + IF(VHDXE(L).GT.0.0.AND.HP(LS).GT.HDRY2)THEN + SVB(L)=1. + SBY(L)=1. + ENDIF + ENDIF + IF(SVBO(LN).GT.0.5)THEN + IF(VHDXE(LN).LT.0.0.AND.HP(LN).GT.HDRY2)THEN + SVB(LN)=1. + SBY(LN)=1. + ENDIF + ENDIF + RDRY=SUB(L)+SUB(L+1)+SVB(L)+SVB(LN) + IF(RDRY.LT.0.5)THEN + ISCDRY(L)=1 + ELSE + ISCDRY(L)=0 + ENDIF + TMPVAL=ABS(SUB(L)-SUBW) + IF(TMPVAL.GT.0.5)THEN + ICORDRY=1 + ELSE + TMPVAL=ABS(SUB(L+1)-SUBE) + IF(TMPVAL.GT.0.5)THEN + ICORDRY=1 + ELSE + TMPVAL=ABS(SVB(L)-SVBS) + IF(TMPVAL.GT.0.5)THEN + ICORDRY=1 + ELSE + TMPVAL=ABS(SVB(LN)-SVBN) + IF(TMPVAL.GT.0.5)THEN ICORDRY=1 + ENDIF + ENDIF + ENDIF + ELSE + SUB(L)=0.0 + SUB(L+1)=0.0 + SVB(L)=0.0 + SVB(LN)=0.0 + SBX(L)=0.0 + SBX(L+1)=0.0 + SBY(L)=0.0 + SBY(LN)=0.0 + IF(ISCDRY(L).EQ.0)THEN + ISCDRY(L)=1 + ICORDRY=1 + ENDIF + ENDIF + ENDIF + ENDDO + S1TIME=MPI_TIC() + CALL broadcast_boundary_lbm(SUB,ic) + CALL broadcast_boundary_lbm(SVB,ic) + CALL broadcast_boundary_lbm(SBX,ic) + CALL broadcast_boundary_lbm(SBY,ic) + CALL MPI_ALLREDUCE(ICORDRY,MPI_I4,1,MPI_INTEGER, + & MPI_MAX,MPI_COMM_WORLD,IERR) + ICORDRY=MPI_I4 +CGEO IF(MYRANK.EQ.0) PRINT*,N,2,ICORDRY + MPI_WTIMES(254)=MPI_WTIMES(254)+MPI_TOC(S1TIME) + IF(ICORDRY.EQ.1)THEN + NCORDRY=NCORDRY+1 + GOTO 1000 + ENDIF + ENDIF + MPI_WTIMES(232)=MPI_WTIMES(232)+MPI_TOC(S1TIME) + +C WRITE(8,6960)NCORDRY +C**********************************************************************C +C +C ** COUNT THE NUMBER TO TIME STEPS A CELL IS DRY, AND IF IT HAS BEEN +C ** DRY FOR MORE THAN ABS(NDRYSTP), AND ITS BOTTOM ELEVATION IS HIGHER +C ** THAN THE SURROUNDING DRY CELLS, THEN REDUCE ITS DEPTH BELOW THE +C ** DRYING DEPTH IF NECESSARY. SAVE VOLUME REDUCTION RATE AS QDWASTE +C ** DEFINED AS POSITIVE OUT. THEN ADJUST CONCENTRATIONS +C + S1TIME=MPI_TIC() + IF(ISDRY.GT.0) THEN + IF(NDRYSTP.LT.0) THEN + NTMP=ABS(NDRYSTP) +!$OMP PARALLEL DO PRIVATE(LN,LS,RDRY,BELVAVG,RVAL,HOLDTMP,TMPVAL) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + QDWASTE(L)=0. + IQDRYDWN(L)=0 + RDRY=SUB(L)+SUB(L+1)+SVB(L)+SVB(LN) + IF(RDRY.GT.0.5)NATDRY(L)=0 + IF(RDRY.LT.0.5)NATDRY(L)=NATDRY(L)+1 + IF(NATDRY(L).GT.NTMP)THEN + IF(HP(L).GE.HDRY)THEN + BELVAVG=0.0 + RVAL=0.0 + IF(HP(L+1).LT.HDRY.AND.SUBO(L+1).GT.0.5)THEN + BELVAVG=BELVAVG+BELV(L+1) + RVAL=RVAL+1. + ENDIF + IF(HP(L-1).LT.HDRY.AND.SUBO(L).GT.0.5)THEN + BELVAVG=BELVAVG+BELV(L-1) + RVAL=RVAL+1. + ENDIF + IF(HP(LN).LT.HDRY.AND.SVBO(LN).GT.0.5)THEN + BELVAVG=BELVAVG+BELV(LN) + RVAL=RVAL+1. + ENDIF + IF(HP(LS).LT.HDRY.AND.SVBO(L).GT.0.5)THEN + BELVAVG=BELVAVG+BELV(LS) + RVAL=RVAL+1. + ENDIF + IF(BELV(L).GE.BELVAVG)THEN + HOLDTMP=HP(L) + IQDRYDWN(L)=1 + HP(L)=0.90*HDRY + NATDRY(L)=0 + QDWASTE(L)=DELTI*DXYP(L)*(HOLDTMP-HP(L)) + VDWASTE(L)=VDWASTE(L)+DXYP(L)*(HOLDTMP-HP(L)) + TMPVAL=HOLDTMP/HP(L) + ENDIF + END IF + ENDIF + IF(QDWASTE(L).GT.0.0)THEN + TMPVAL=QDWASTE(L)/DXYP(L) + ENDIF + ENDDO + ENDIF + ENDIF + MPI_WTIMES(233)=MPI_WTIMES(233)+MPI_TOC(S1TIME) +C +C 8888 FORMAT(' QDW ',2I6,6E14.6) +C +C**********************************************************************C +C +C ** PERFORM FINAL UPDATES OF P,HU, AND HV +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + P(L)=G*(HP(L)+BELV(L)) + ENDDO +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + HU(L)=0.5*(DXYP(L)*HP(L)+DXYP(L-1)*HP(L-1))*DXYIU(L) + HV(L)=0.5*(DXYP(L)*HP(L)+DXYP(LS )*HP(LS ))*DXYIV(L) + H1P(L)=H2P(L) ! *** DSLLC, UPDATE THE LAST DEPTH TO ACTUAL PREVIOUS + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HPI(L)=1./HP(L) + HUI(L)=1./HU(L) + HVI(L)=1./HV(L) + ENDDO + MPI_WTIMES(234)=MPI_WTIMES(234)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(HU,ic) + CALL broadcast_boundary(HV,ic) + MPI_WTIMES(255)=MPI_WTIMES(255)+MPI_TOC(S1TIME) +C +C ** SET TRANSPORT MASK FOR DRY CELLS +C + S1TIME=MPI_TIC() + CALL broadcast_boundary(SUB1,ic) + CALL broadcast_boundary(SVB1,ic) + IF(ISDRY.GT.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IMASKDRY(L)=0 + LMASKDRY(L)=.TRUE. + END DO + IF(IDRYTBP.EQ.1)THEN + LMPI2IC=MAX(2,LMPI2-IC) +!$OMP PARALLEL DO PRIVATE(LN,IUW,IUE,IVS,IVN,IFACE) + DO L=LMPI2IC,LMPILA + LN=LNC(L) + IUW=0 + IUE=0 + IVS=0 + IVN=0 + IF(SUB1(L).LT.0.5.AND.SUB(L).LT.0.5)IUE=1 + IF(SUB1(L+1).LT.0.5.AND.SUB(L+1).LT.0.5)IUW=1 + IF(SVB1(L).LT.0.5.AND.SVB(L).LT.0.5)IVS=1 + IF(SVB1(LN).LT.0.5.AND.SVB(LN).LT.0.5)IVN=1 + IFACE=IUW+IUE+IVS+IVN + IF(IFACE.EQ.4)THEN + IMASKDRY(L)=1 + LMASKDRY(L)=.FALSE. + IF(H1P(L).EQ.HP(L))IMASKDRY(L)=2 + END IF + IF(IQDRYDWN(L).EQ.1)THEN + IMASKDRY(L)=0 + LMASKDRY(L)=.TRUE. + ENDIF + END DO + END IF + END IF + MPI_WTIMES(235)=MPI_WTIMES(235)+MPI_TOC(S1TIME) +C +C ** OUTPUT DIAGNOSTICS FOR 2 GRID INTERATCTION +C + S1TIME=MPI_TIC() + IF(MDCHH.GT.0.AND.DEBUG)THEN + IF(MDCHHD.GT.0)THEN + IVAL=MOD(N,MDCHHD2) + IF(IVAL.EQ.0)THEN + IF(IACTALL.GT.0)THEN + IF(DEBUG)OPEN(1,FILE='MODCHAN.OUT',POSITION='APPEND') + DO NMD=1,MDCHH + WRITE(1,8000) + LHOST=LMDCHH(NMD) + IHOST=IL(LHOST) + JHOST=JL(LHOST) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) +C X-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.1)THEN + ICHNU=IL(LCHNU) + JCHNU=JL(LCHNU) + SRFCHAN=HP(LCHNU)+BELV(LCHNU) + SRFHOST=HP(LHOST)+BELV(LHOST) + SRFCHAN1=H1P(LCHNU)+BELV(LCHNU) + SRFHOST1=H1P(LHOST)+BELV(LHOST) + IF(MYRANK.EQ.0)THEN + WRITE(1,8001)N,NMD,MDCHTYP(NMD),ICHNU,JCHNU, + & ISCDRY(LCHNU),SRFCHAN,HP(LCHNU),SRFCHAN1,H1P(LCHNU) + WRITE(1,8002)IHOST,JHOST,ISCDRY(LHOST), + & SRFHOST,HP(LHOST),SRFHOST1,H1P(LHOST) + WRITE(1,8003)QCHANU(NMD),QCHANUT(NMD),CCCCHU(NMD) + & ,CCCCHV(NMD) + ENDIF + ENDIF +C Y-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.2)THEN + ICHNV=IL(LCHNV) + JCHNV=JL(LCHNV) + SRFCHAN=HP(LCHNV)+BELV(LCHNV) + SRFHOST=HP(LHOST)+BELV(LHOST) + SRFCHAN1=H1P(LCHNV)+BELV(LCHNV) + SRFHOST1=H1P(LHOST)+BELV(LHOST) + IF(MYRANK.EQ.0)THEN + WRITE(1,8001)N,NMD,MDCHTYP(NMD),ICHNV,JCHNV, + & ISCDRY(LCHNV),SRFCHAN,HP(LCHNV),SRFCHAN1,H1P(LCHNV) + WRITE(1,8002)IHOST,JHOST,ISCDRY(LHOST), + & SRFHOST,HP(LHOST),SRFHOST1,H1P(LHOST) + WRITE(1,8003)QCHANV(NMD),QCHANVT(NMD),CCCCHU(NMD) + & ,CCCCHV(NMD) + ENDIF + ENDIF + WRITE(1,8004) + ENDDO + CLOSE(1) + ENDIF + ENDIF + ENDIF + ENDIF + MPI_WTIMES(236)=MPI_WTIMES(236)+MPI_TOC(S1TIME) +C +C ** PERFORM UPDATE ON GROUNDWATER ELEVATION +C + S1TIME=MPI_TIC() + IF(ISGWIE.GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + QSUM(L,KC)=QSUM(L,KC)-EVAPSW(L) + QSUM(L,1 )=QSUM(L,1 )-RIFTR(L) + ENDDO +C +C INFILTRATION STEP +C + RNPORI=1./RNPOR + IF(ISTL.EQ.3)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV(L)=AGWELV2(L)+RNPORI*DELT*DXYIP(L)*RIFTR(L) + ENDDO + ELSE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV(L)=AGWELV1(L)+RNPORI*DELT*DXYIP(L)*RIFTR(L) + ENDDO + ENDIF +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV(L)=MIN(AGWELV(L),BELV(L)) + ENDDO +C +C ET STEP +C +!$OMP PARALLEL DO PRIVATE(SVPW,ETGWTMP,ETGWAVL) + DO L=LMPI2,LMPILA + IF(EVAPCVT.LT.0.)THEN + SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ + & (1.+0.00412*TEM(L,KC)))) + EVAPT(L)=CLEVAP(L)*0.7464E-3*WINDST(L)*(SVPW-VPA(L))/PATMT(L) + ENDIF + ETGWTMP=EVAPT(L)-EVAPSW(L)*DXYIP(L) + ETGWTMP=MAX(ETGWTMP,0.0) + ETGWAVL=RNPOR*DELTI*(AGWELV(L)-BELAGW(L)) + ETGWAVL=MAX(ETGWAVL,0.0) + ETGWTMP=MIN(ETGWTMP,ETGWAVL) + EVAPGW(L)=ETGWTMP*DXYP(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV(L)=AGWELV(L)-RNPORI*DELT*DXYIP(L)*EVAPGW(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AGWELV(L)=MAX(AGWELV(L),BELAGW(L)) + ENDDO + ENDIF + MPI_WTIMES(237)=MPI_WTIMES(237)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(N.EQ.NTS.AND.DEBUG.AND.MYRANK.EQ.0)THEN + IF(MDCHH.GT.0)THEN + DO NMD=1,MDCHH + WRITE(8,8000) + LHOST=LMDCHH(NMD) + IHOST=IL(LHOST) + JHOST=JL(LHOST) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) +C X-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.1)THEN + ICHNU=IL(LCHNU) + JCHNU=JL(LCHNU) + SRFCHAN=HP(LCHNU)+BELV(LCHNU) + SRFHOST=HP(LHOST)+BELV(LHOST) + SRFCHAN1=H1P(LCHNU)+BELV(LCHNU) + SRFHOST1=H1P(LHOST)+BELV(LHOST) + IF(MYRANK.EQ.0)THEN + WRITE(8,8001)N,NMD,MDCHTYP(NMD),ICHNU,JCHNU,ISCDRY(LCHNU), + & SRFCHAN,HP(LCHNU),P1(LCHNU),H1P(LCHNU) + WRITE(8,8002)IHOST,JHOST,ISCDRY(LHOST), + & SRFHOST,HP(LHOST),P1(LHOST),H1P(LHOST) + WRITE(8,8003)QCHANU(NMD),QCHANUT(NMD),CCCCHU(NMD), + & CCCCHV(NMD) + ENDIF + ENDIF +C Y-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.2)THEN + ICHNV=IL(LCHNV) + JCHNV=JL(LCHNV) + SRFCHAN=HP(LCHNV)+BELV(LCHNV) + SRFHOST=HP(LHOST)+BELV(LHOST) + SRFCHAN1=H1P(LCHNV)+BELV(LCHNV) + SRFHOST1=H1P(LHOST)+BELV(LHOST) + IF(MYRANK.EQ.0)THEN + WRITE(8,8001)N,NMD,MDCHTYP(NMD),ICHNV,JCHNV,ISCDRY(LCHNV), + & SRFCHAN,HP(LCHNV),SRFCHAN1,H1P(LCHNV) + WRITE(8,8002)IHOST,JHOST,ISCDRY(LHOST), + & SRFHOST,HP(LHOST),SRFHOST1,H1P(LHOST) + WRITE(8,8003)QCHANV(NMD),QCHANVT(NMD),CCCCHU(NMD), + & CCCCHV(NMD) + ENDIF + ENDIF + WRITE(8,8004) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(238)=MPI_WTIMES(238)+MPI_TOC(S1TIME) +C +C ** CHECK FOR NEGATIVE DEPTHS +C + S1TIME=MPI_TIC() + IF(ISNEGH.GE.1)CALL NEGDEP(QCHANUT,QCHANVT,2) + MPI_WTIMES(239)=MPI_WTIMES(239)+MPI_TOC(S1TIME) +C6910 FORMAT(' DRYING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6911 FORMAT(' DRY W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6912 FORMAT(' DRY E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6913 FORMAT(' DRY S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6914 FORMAT(' DRY N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6920 FORMAT(' WETTING AT N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6921 FORMAT(' WET S FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6922 FORMAT(' WET W FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6923 FORMAT(' WET E FACE N,I,J =',I10,2I6,' HU,H,H1 =',3(2X,E12.4)) +C6924 FORMAT(' WET N FACE N,I,J =',I10,2I6,' HV,H,H1 =',3(2X,E12.4)) +C6930 FORMAT(' WET BY VOL N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6940 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6941 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUE,HP,H1P =' +C & ,3(2X,E12.4)) +C6942 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HUW,HP,H1P =' +C & ,3(2X,E12.4)) +C6943 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVS,HP,H1P =' +C & ,3(2X,E12.4)) +C6944 FORMAT(' RESOLVE, N,I,J =',I10,2I6,' HVN,HP,H1P =' +C & ,3(2X,E12.4)) +C6945 FORMAT(' RESOLVE NEG, N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) +C6950 FORMAT(' RESOLVE, NEG DEP N,I,J =',I10,2I6,' HP,H1P,H2P =' +C & ,3(2X,E12.4)) + 8001 FORMAT(I7,5I5,4E13.4) + 8002 FORMAT(17X,3I5,4E13.4) + 8003 FORMAT(32X,4E13.4) + 8000 FORMAT(' N NMD MTYP I J IDRY P H', + & ' P1 H1') + 8004 FORMAT(' QCHANU', + & ' QCHANUT CCCCHU CCCCHV ') +C +C ** CALCULATE THE EXTERNAL DIVERGENCE +C + S1TIME=MPI_TIC() + IF(ISDIVEX.EQ.1)THEN + DIVEXMX=0. + DIVEXMN=1000000. + DO L=2,LA + IF(SPB(L).NE.0)THEN + LN=LNC(L) + DIVEX=SPB(L)*(DXYP(L)*(HP(L)-H1P(L))*DELTI + & +0.5*(UHDYE(L+1)+UHDY1E(L+1)-UHDYE(L)-UHDY1E(L) + & +VHDXE(LN)+VHDX1E(LN)-VHDXE(L)-VHDX1E(L))-QSUME(L) + & +RIFTR(L)+EVAPSW(L)) + IF(DIVEX.GT.DIVEXMX)THEN + DIVEXMX=DIVEX + LMAX=L + ENDIF + IF(DIVEX.LT.DIVEXMN)THEN + DIVEXMN=DIVEX + LMIN=L + ENDIF + ENDIF + ENDDO + IMAX=IL(LMAX) + JMAX=JL(LMAX) + IMIN=IL(LMIN) + JMIN=JL(LMIN) + IF(MYRANK.EQ.0)WRITE(6,6628)DIVEXMX,IMAX,JMAX + IF(MYRANK.EQ.0)WRITE(6,6629)DIVEXMN,IMIN,JMIN + ENDIF + MPI_WTIMES(240)=MPI_WTIMES(240)+MPI_TOC(S1TIME) +C 566 FORMAT(' I=',I5,3X,'J=',I5,3X,'HP=',F12.4) + 6628 FORMAT(' DIVEXMX=',E13.5,5X,2I10) + 6629 FORMAT(' DIVEXMN=',E13.5,5X,2I10) +C +C ** UPDATE ZERO DIMENSION VOLUME BALANCE +C + ISTL=2 + S1TIME=MPI_TIC() + IF(ISDRY.GE.1.AND.ISTL.EQ.3)THEN + VOLADD=0. +!$OMP PARALLEL DO REDUCTION(+:VOLADD) + DO L=LMPI2,LMPILA + IF(SPB(L).NE.0)THEN + VOLADD=VOLADD+QSUME(L)-RIFTR(L)-EVAPSW(L) + ENDIF + ENDDO + CALL MPI_ALLREDUCE(VOLADD,MPI_R4,1,MPI_REAL, + & MPI_MIN,MPI_COMM_WORLD,IERR) + VOLADD=MPI_R4 + VOLADD=VOLADD*DT + VOLZERD=VOLZERD+VOLADD + VETZERD=VETZERD+VOLADD+DT*EVAPSW(L) + ENDIF + MPI_WTIMES(241)=MPI_WTIMES(241)+MPI_TOC(S1TIME) +C5303 FORMAT(2X,F10.4,2X,F10.5,3(2X,E13.5)) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD_mpi.for new file mode 100644 index 000000000..45b5e0e34 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2TOLD_mpi.for @@ -0,0 +1,691 @@ + SUBROUTINE CALQQ2TOLD_mpi (ISTL_) +C +C CHANGE RECORD +C FIXED DYNAMIC TIME STEPPING +C 03/18/2004 PAUL CRAIG +C MADE CHANGES SO DML AND QQL ARE DIMENSIONALLY CORRECT +C ** SUBROUTINE CALQQ CALCULATES THE TURBULENT INTENSITY SQUARED AT +C ** TIME LEVEL (N+1). THE VALUE OF ISTL INDICATES THE NUMBER OF +C ** TIME LEVELS INVOLVED +C + USE GLOBAL + USE MPI +C + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + DELTD2=0.5*DT + DELTI=1./DELT + ELSE + DELT=DTDYN + DELTD2=0.5*DTDYN + DELTI=1./DELT + END IF + S2TL=0.0 + BSMALL=1.E-12 +C + S1TIME=MPI_TIC() + DO K=0,KCM + CALL broadcast_boundary(QQ(:,K),ic) + CALL broadcast_boundary(QQL(:,K),ic) + ENDDO + MPI_WTIMES(513)=MPI_WTIMES(513)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + QQ2(L,K)=QQ(L,K)+QQ(L,K) + QQL2(L,K)=QQL(L,K)+QQL(L,K) + ENDDO + ENDDO + MPI_WTIMES(501)=MPI_WTIMES(501)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + UUU(L,KC)=0. + VVV(L,KC)=0. + FUHU(L,KC)=0. + FUHV(L,KC)=0. + FVHU(L,KC)=0. + FUHV(L,KC)=0. + ENDDO + MPI_WTIMES(502)=MPI_WTIMES(502)+MPI_TOC(S1TIME) +C +C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH TRANSPORT +C ** AVERAGED BETWEEN (N) AND (N+1) AND TRANSPORTED FIELD AT (N) OR +C ** TRANSPORT BETWEEN (N-1) AND (N+1) AND TRANSPORTED FIELD AT (N-1) +C ** FOR ISTL EQUAL TO 2 AND 3 RESPECTIVELY +C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(WB) + DO L=LMPI2,LMPILA + WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) + FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) + & +MIN(WB,0.)*QQ(L,K) + FWQQL(L,K)=MAX(WB,0.)*QQL(L,K-1) + & +MIN(WB,0.)*QQL(L,K) + ENDDO + ENDDO + ELSE + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(WB) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) + FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) + & +MIN(WB,0.)*QQ(L,K) + FWQQL(L,K)=MAX(WB,0.)*QQL(L,K-1) + & +MIN(WB,0.)*QQL(L,K) + ELSE + FWQQ(L,K)=0. + FWQQL(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(503)=MPI_WTIMES(503)+MPI_TOC(S1TIME) +C +C ELSE +C WB=0.25*DXYP(L)*(W2(L,K-1)+W2(L,K)) +C ELSE +C WB=0.25*DXYP(L)*(W2(L,K-1)+W2(L,K)) +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS,UHUW,VHVW) + DO L=LMPI2,LMPILA + LS=LSC(L) + UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) + VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) + FUHU(L,K)=MAX(UHUW,0.)*QQ(L-1,K) + & +MIN(UHUW,0.)*QQ(L,K) + FVHU(L,K)=MAX(VHVW,0.)*QQ(LS,K) + & +MIN(VHVW,0.)*QQ(L,K) + FUHV(L,K)=MAX(UHUW,0.)*QQL(L-1,K) + & +MIN(UHUW,0.)*QQL(L,K) + FVHV(L,K)=MAX(VHVW,0.)*QQL(LS,K) + & +MIN(VHVW,0.)*QQL(L,K) + ENDDO + ENDDO + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS,UHUW,VHVW) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) + VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) + FUHU(L,K)=MAX(UHUW,0.)*QQ(L-1,K) + & +MIN(UHUW,0.)*QQ(L,K) + FVHU(L,K)=MAX(VHVW,0.)*QQ(LS,K) + & +MIN(VHVW,0.)*QQ(L,K) + FUHV(L,K)=MAX(UHUW,0.)*QQL(L-1,K) + & +MIN(UHUW,0.)*QQL(L,K) + FVHV(L,K)=MAX(VHVW,0.)*QQL(LS,K) + & +MIN(VHVW,0.)*QQL(L,K) + ELSE + FUHU(L,K)=0. + FUHV(L,K)=0. + FVHU(L,K)=0. + FUHV(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(504)=MPI_WTIMES(504)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FUHV,ic) + CALL broadcast_boundary_array(FVHV,ic) + MPI_WTIMES(514)=MPI_WTIMES(514)+MPI_TOC(S1TIME) +C +C ELSE +C UHUW=0.25*(UHDY2(L,K)+UHDY2(L,K+1)) +C VHVW=0.25*(VHDX2(L,K)+VHDX2(L,K+1)) +C ELSE +C UHUW=0.25*(UHDY2(L,K)+UHDY2(L,K+1)) +C VHVW=0.25*(VHDX2(L,K)+VHDX2(L,K+1)) +C ** CALCULATE PRODUCTION, LOAD BOUNDARY CONDITIONS AND SOLVE +C ** TRANSPORT EQUATIONS +C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV +C ** CU1=CUQ, CU2=CUQL, UUU=QQH, VVV=QQLH +C + S1TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + IF(FVHU(LN,K).GT.0)THEN + FVHU(LN,K)=0.0 + FVHV(LN,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + IF(FUHU(L+1,K).GT.0)THEN + FUHU(L+1,K)=0.0 + FUHV(L+1,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + IF(FUHU(L,K).LT.0.)THEN + FUHU(L,K)=0.0 + FUHV(L,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + IF(FVHU(L,K).LT.0.)THEN + FVHU(L,K)=0.0 + FVHV(L,K)=0.0 + ENDIF + ENDDO + ENDDO + MPI_WTIMES(505)=MPI_WTIMES(505)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISWAVE.LE.1.OR.ISWAVE.EQ.3)THEN + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + UUU(L,K)=QQ(L,K)*H1P(L) + & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + & +(FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K))*DXYIP(L) + VVV(L,K)=QQL(L,K)*H1P(L) + & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UUU(L,K)=MAX(UUU(L,K),0.) + VVV(L,K)=MAX(VVV(L,K),0.) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQ) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1)- + & U(L,K))**2+AV(L,K)*DZIGSD4(K)*(V(LN,K+1)-V(LN,K)+V(L,K+1)- + & V(L,K))**2 + PQQ=DELT*(PQQB+PQQU) + UUU(L,K)=UUU(L,K)+2.*PQQ + VVV(L,K)=VVV(L,K)+CTE1*DML(L,K)*PQQ + ENDDO + ENDDO + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + UUU(L,K)=QQ(L,K)*H1P(L) + & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + & +(FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K))*DXYIP(L) + VVV(L,K)=QQL(L,K)*H1P(L) + & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + + UUU(L,K)=MAX(UUU(L,K),0.) + VVV(L,K)=MAX(VVV(L,K),0.) + ELSE + UUU(L,K)=0.0 + VVV(L,K)=0.0 + ENDIF + ENDDO + ENDDO + IF(PRINT_SUM)THEN + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'U3UU = ', sum(abs(dble(UUU))) + PRINT*, n,'V3VV = ', sum(abs(dble(VVV))) + PRINT*, N,'TEMO = ', TEMO + ENDIF + ENDIF +C + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQ) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1) + & -U(L,K))**2+AV(L,K)*DZIGSD4(K)*(V(LN,K+1)-V(LN,K)+V(L,K+1)- + & V(L,K))**2 + PQQ=DELT*(PQQB+PQQU) + UUU(L,K)=UUU(L,K)+2.*PQQ + VVV(L,K)=VVV(L,K)+CTE1*DML(L,K)*PQQ + ENDIF + ENDDO + ENDDO + IF(PRINT_SUM)THEN + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + call collect_in_zero_array(AB) + call collect_in_zero_array(AV) + call collect_in_zero_array(B) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'U4UU = ', sum(abs(dble(UUU))) + PRINT*, n,'V4VV = ', sum(abs(dble(VVV))) + PRINT*, n,'AB4 = ', sum(abs(dble(AB))) + PRINT*, n,'AV4 = ', sum(abs(dble(AV))) + PRINT*, n,'B4 = ', sum(abs(dble(B))) + PRINT*, n,'U4 = ', sum(abs(dble(U))) + PRINT*, n,'V4 = ', sum(abs(dble(V))) + ENDIF + ENDIF + ENDIF +C +C ELSE +C + ENDIF + MPI_WTIMES(506)=MPI_WTIMES(506)+MPI_TOC(S1TIME) +C +C *** DSLLC BEGIN BLOCK +C + IF(ISWAVE.EQ.2)THEN + IF(N.LT.NTSWV)THEN + TMPVAL=FLOAT(N)/FLOAT(NTSWV) + WVFACT=0.5-0.5*COS(PI*TMPVAL) + ELSE + WVFACT=1.0 + ENDIF + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1W(L,K)=WVDTKEM(K)*WVDISP(L,K)+WVDTKEP(K)*WVDISP(L,K+1) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQV,PQQW,PQQ,PQQL,FFTMP) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)* + & (U(L+1,K+1)-U(L+1,K)+U(L,K+1)-U(L,K))**2 + PQQV=AV(L,K)*DZIGSD4(K)* + & (V(LN,K+1)-V(LN,K)+V(L,K+1)-V(L,K))**2 + PQQW= WVFACT*TVAR1W(L,K) + PQQ=DELT*(PQQU+PQQV+PQQB+PQQW) + FFTMP=MAX(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + + & (FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K),0.) + UUU(L,K)=QQ(L,K)*H1P(L)+DELT*FFTMP*DXYIP(L) + 2.*PQQ + PQQL=DELT*(CTE3*PQQB+CTE1*(PQQU+PQQV+PQQW)) + FFTMP=MAX(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + + & (FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K),0.) + VVV(L,K)=QQL(L,K)*H1P(L)+DELT*FFTMP*DXYIP(L) + + & DML(L,K)*PQQL + ENDDO + ENDDO + ENDIF +C +C *** DSLLC END BLOCK +C + S1TIME=MPI_TIC() + IF(KC.LE.2)THEN + IF(IDRYTBP.EQ.0)THEN +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0) + & -CUQTMP*HP(L)*QQ(L,KC))*EQ + VVV(L,1)=VVV(L,1)*EQL + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0) + & -CUQTMP*HP(L)*QQ(L,KC))*EQ + VVV(L,1)=VVV(L,1)*EQL + ENDIF + ENDDO + ENDIF + ENDIF + MPI_WTIMES(508)=MPI_WTIMES(508)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(KC.GT.2)THEN + IF(IDRYTBP.EQ.0)THEN +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0))*EQ + VVV(L,1)=VVV(L,1)*EQL + CUQTMP=-DELT*CDZKKP(KS)*AQ(L,KC)*HPI(L) + UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) + ENDDO + DO K=2,KS +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) + CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)))*(1. + & +CTE2*DML(L,K)*DML(L,K)*FPROX(K)) + EQ=1./(CMQTMP-CLQTMP*CU1(L,K-1)) + EQL=1./(CMQLTMP-CLQTMP*CU2(L,K-1)) + CU1(L,K)=CUQTMP*EQ + CU2(L,K)=CUQTMP*EQL +C +C IF(EQ.0) PAUSE +C + UUU(L,K)=(UUU(L,K)-CLQTMP*UUU(L,K-1))*EQ + VVV(L,K)=(VVV(L,K)-CLQTMP*VVV(L,K-1))*EQL + ENDDO + ENDDO + DO K=KS-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) + VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) + ENDDO + ENDDO + IF(PRINT_SUM)THEN + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'UUU = ', sum(abs(dble(UUU))) + PRINT*, n,'VVV = ', sum(abs(dble(VVV))) + ENDIF + ENDIF + ELSE +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0))*EQ + VVV(L,1)=VVV(L,1)*EQL + CUQTMP=-DELT*CDZKKP(KS)*AQ(L,KC)*HPI(L) + UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) + ENDIF + ENDDO + DO K=2,KS +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) + CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + & )*(1.+CTE2*DML(L,K)*DML(L,K)*FPROX(K)) + EQ=1./(CMQTMP-CLQTMP*CU1(L,K-1)) + EQL=1./(CMQLTMP-CLQTMP*CU2(L,K-1)) + CU1(L,K)=CUQTMP*EQ + CU2(L,K)=CUQTMP*EQL +C +C IF(EQ.0) PAUSE +C + UUU(L,K)=(UUU(L,K)-CLQTMP*UUU(L,K-1))*EQ + VVV(L,K)=(VVV(L,K)-CLQTMP*VVV(L,K-1))*EQL + ENDIF + ENDDO + ENDDO + DO K=KS-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) + VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(509)=MPI_WTIMES(509)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FUHV) + call collect_in_zero_array(FVHV) + call collect_in_zero_array(CU1) + call collect_in_zero_array(CU2) + call collect_in_zero_array(AQ) + call collect_in_zero(HPI) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'UUU = ', sum(abs(dble(UUU))) + PRINT*, n,'VVV = ', sum(abs(dble(VVV))) + PRINT*, n,'FUHU = ', sum(abs(dble(FUHU))) + PRINT*, n,'FVHU = ', sum(abs(dble(FVHU))) + PRINT*, n,'FUHV = ', sum(abs(dble(FUHV))) + PRINT*, n,'FVHV = ', sum(abs(dble(FVHV))) + PRINT*, n,'CU1 = ', sum(abs(dble(CU1))) + PRINT*, n,'CU2 = ', sum(abs(dble(CU2))) + PRINT*, n,'AQ = ', sum(abs(dble(AQ))) + PRINT*, n,'HPI = ', sum(abs(dble(HPI))) + ENDIF + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + call collect_in_zero(DML(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'1QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'1QQL = ', sum(abs(dble(QQL))) + PRINT*, n,'1QQL = ', sum(abs(dble(DML))) + ENDIF + ENDIF +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH) + DO L=LMPI2,LMPILA + QQ1(L,K)=QQ(L,K) + QQHDH=UUU(L,K)*HPI(L) + QQ(L,K)=MAX(QQHDH,QQMIN) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP,DELB,DMLMAX) + DO L=LMPI2,LMPILA + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DMLTMP=MAX(DMLTMP,DMLMIN) + DELB=B(L,K)-B(L,K+1) + IF(DELB.GT.BSMALL.AND.ISTOPT(0).EQ.0)THEN + DMLMAX=0.53*SQRT(QQ(L,K)/(G*HP(L)*DZIG(K)*DELB)) + DML(L,K)=MIN(DMLMAX,DMLTMP) + ELSE + DML(L,K)=DMLTMP + ENDIF + ENDDO + ENDDO + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQ1(L,K)=QQ(L,K) + QQHDH=UUU(L,K)*HPI(L) + QQ(L,K)=MAX(QQHDH,QQMIN) + ENDIF + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP,DELB,DMLMAX) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DMLTMP=MAX(DMLTMP,DMLMIN) + DELB=B(L,K)-B(L,K+1) + IF(DELB.GT.BSMALL.AND.ISTOPT(0).EQ.0)THEN + DMLMAX=0.53*SQRT(QQ(L,K)/(G*HP(L)*DZIG(K)*DELB)) + DML(L,K)=MIN(DMLMAX,DMLTMP) + ELSE + DML(L,K)=DMLTMP + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF +C + MPI_WTIMES(510)=MPI_WTIMES(510)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'2QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'2QQL = ', sum(abs(dble(QQL))) + ENDIF + ENDIF +C +C QQMXSV=-1.E+12 +C QQMNSV=1.E+12 +C QQLMXSV=-1.E+12 +C QQLMNSV=1.E+12 +C + S1TIME=MPI_TIC() + DO K=1,KS + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + QQ(L,K)=QQ(LN,K) + QQL(L,K)=QQL(LN,K) + DML(L,K)=DML(LN,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBW + L=LCBW(LL) + QQ(L,K)=QQ(L+1,K) + QQL(L,K)=QQL(L+1,K) + DML(L,K)=DML(L+1,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBE + L=LCBE(LL) + QQ(L,K)=QQ(L-1,K) + QQL(L,K)=QQL(L-1,K) + DML(L,K)=DML(L-1,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBN + L=LCBN(LL) + LS=LSC(L) + QQ(L,K)=QQ(LS,K) + QQL(L,K)=QQL(LS,K) + DML(L,K)=DML(LS,K) + ENDDO + ENDDO +C *** DSLLC BEGIN BLOCK + MPI_WTIMES(511)=MPI_WTIMES(511)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + QQSQR(L,K)=SQRT(QQ(L,K)) ! *** DSLLC + ENDDO + ENDDO + MPI_WTIMES(512)=MPI_WTIMES(512)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=0,KCM + CALL broadcast_boundary(QQ(:,K),ic) + CALL broadcast_boundary(QQ1(:,K),ic) + CALL broadcast_boundary(QQL(:,K),ic) + CALL broadcast_boundary(QQL1(:,K),ic) + CALL broadcast_boundary(QQSQR(:,K),ic) + CALL broadcast_boundary(DML(:,K),ic) + ENDDO + MPI_WTIMES(515)=MPI_WTIMES(515)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'3QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'3QQL = ', sum(abs(dble(QQL))) + ENDIF + ENDIF + call mpi_barrier(mpi_comm_world,ierr) +C +C *** DSLLC END BLOCK +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T_mpi.for new file mode 100644 index 000000000..bd5b8a1cc --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQQ2T_mpi.for @@ -0,0 +1,664 @@ + SUBROUTINE CALQQ2T_mpi (ISTL_) +C +C CHANGE RECORD +C FIXED DYNAMIC TIME STEPPING +C ** SUBROUTINE CALQQ CALCULATES THE TURBULENT INTENSITY SQUARED AT +C ** TIME LEVEL (N+1). THE VALUE OF ISTL INDICATES THE NUMBER OF +C ** TIME LEVELS INVOLVED +C + USE GLOBAL + USE MPI + + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + DELTD2=0.5*DT + DELTI=1./DELT + ELSE + DELT=DTDYN + DELTD2=0.5*DTDYN + DELTI=1./DELT + END IF + S2TL=0.0 + BSMALL=1.E-12 + + S1TIME=MPI_TIC() + DO K=0,KCM + CALL broadcast_boundary(QQ(:,K),ic) + CALL broadcast_boundary(QQL(:,K),ic) + ENDDO + MPI_WTIMES(513)=MPI_WTIMES(513)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + QQ2(L,K)=QQ(L,K)+QQ(L,K) + QQL2(L,K)=QQL(L,K)+QQL(L,K) + ENDDO + ENDDO + MPI_WTIMES(501)=MPI_WTIMES(501)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + UUU(L,KC)=0. + VVV(L,KC)=0. + FUHU(L,KC)=0. + FUHV(L,KC)=0. + FVHU(L,KC)=0. + FUHV(L,KC)=0. + ENDDO + MPI_WTIMES(502)=MPI_WTIMES(502)+MPI_TOC(S1TIME) +C +C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH TRANSPORT +C ** AVERAGED BETWEEN (N) AND (N+1) AND TRANSPORTED FIELD AT (N) OR +C ** TRANSPORT BETWEEN (N-1) AND (N+1) AND TRANSPORTED FIELD AT (N-1) +C ** FOR ISTL EQUAL TO 2 AND 3 RESPECTIVELY +C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(WB) + DO L=LMPI2,LMPILA + WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) + FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) + & +MIN(WB,0.)*QQ(L,K) + FWQQL(L,K)=MAX(WB,0.)*QQL(L,K-1)*H1P(L) + & +MIN(WB,0.)*QQL(L,K)*H1P(L) + ENDDO + ENDDO + ELSE + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(WB) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + WB=0.5*DXYP(L)*(W2(L,K-1)+W2(L,K)) + FWQQ(L,K)=MAX(WB,0.)*QQ(L,K-1) + & +MIN(WB,0.)*QQ(L,K) + FWQQL(L,K)=MAX(WB,0.)*QQL(L,K-1)*H1P(L) + & +MIN(WB,0.)*QQL(L,K)*H1P(L) + ELSE + FWQQ(L,K)=0. + FWQQL(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(503)=MPI_WTIMES(503)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS,UHUW,VHVW) + DO L=LMPI2,LMPILA + LS=LSC(L) + UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) + VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) + FUHU(L,K)=MAX(UHUW,0.)*QQ(L-1,K) + & +MIN(UHUW,0.)*QQ(L,K) + FVHU(L,K)=MAX(VHVW,0.)*QQ(LS,K) + & +MIN(VHVW,0.)*QQ(L,K) + FUHV(L,K)=MAX(UHUW,0.)*QQL(L-1,K)*H1P(L-1) + & +MIN(UHUW,0.)*QQL(L,K)*H1P(L) + FVHV(L,K)=MAX(VHVW,0.)*QQL(LS,K)*H1P(LS) + & +MIN(VHVW,0.)*QQL(L,K)*H1P(L) + ENDDO + ENDDO + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LS,UHUW,VHVW) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + UHUW=0.5*(UHDY2(L,K)+UHDY2(L,K+1)) + VHVW=0.5*(VHDX2(L,K)+VHDX2(L,K+1)) + FUHU(L,K)=MAX(UHUW,0.)*QQ(L-1,K) + & +MIN(UHUW,0.)*QQ(L,K) + FVHU(L,K)=MAX(VHVW,0.)*QQ(LS,K) + & +MIN(VHVW,0.)*QQ(L,K) + FUHV(L,K)=MAX(UHUW,0.)*QQL(L-1,K)*H1P(L-1) + & +MIN(UHUW,0.)*QQL(L,K)*H1P(L) + FVHV(L,K)=MAX(VHVW,0.)*QQL(LS,K)*H1P(LS) + & +MIN(VHVW,0.)*QQL(L,K)*H1P(L) + ELSE + FUHU(L,K)=0. + FUHV(L,K)=0. + FVHU(L,K)=0. + FUHV(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(504)=MPI_WTIMES(504)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FUHV,ic) + CALL broadcast_boundary_array(FVHV,ic) + MPI_WTIMES(514)=MPI_WTIMES(514)+MPI_TOC(S1TIME) +C +C ** CALCULATE PRODUCTION, LOAD BOUNDARY CONDITIONS AND SOLVE +C ** TRANSPORT EQUATIONS +C ** FUHQQ=FUHU, FVHQQ=FVHU, FUHQQL=FUHV, FVHQQL=FVHV +C ** CU1=CUQ, CU2=CUQL, UUU=QQH, VVV=QQLH +C + S1TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + IF(FVHU(LN,K).GT.0)THEN + FVHU(LN,K)=0.0 + FVHV(LN,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + IF(FUHU(L+1,K).GT.0)THEN + FUHU(L+1,K)=0.0 + FUHV(L+1,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + IF(FUHU(L,K).LT.0.)THEN + FUHU(L,K)=0.0 + FUHV(L,K)=0.0 + ENDIF + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + IF(FVHU(L,K).LT.0.)THEN + FVHU(L,K)=0.0 + FVHV(L,K)=0.0 + ENDIF + ENDDO + ENDDO + MPI_WTIMES(505)=MPI_WTIMES(505)+MPI_TOC(S1TIME) + + + S1TIME=MPI_TIC() + IF(ISWAVE.LE.1.OR.ISWAVE.EQ.3)THEN + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + UUU(L,K)=QQ(L,K)*H1P(L) + & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + & +(FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K))*DXYIP(L) + VVV(L,K)=QQL(L,K)*H1P(L)*H1P(L) + & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UUU(L,K)=MAX(UUU(L,K),0.) + VVV(L,K)=MAX(VVV(L,K),0.) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQ,PQQL) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1)- + & U(L,K))**2+AV(L,K)*DZIGSD4(K)*(V(LN,K+1)-V(LN,K)+V( + & L,K+1)-V(L,K))**2 + PQQ=DELT*(PQQB+PQQU) + UUU(L,K)=UUU(L,K)+2.*PQQ + PQQL=DELT*H1P(L)*(CTE3*PQQB+CTE1*PQQU) + VVV(L,K)=VVV(L,K)+DML(L,K)*PQQL + ENDDO + ENDDO + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + UUU(L,K)=QQ(L,K)*H1P(L) + & +DELT*(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + & +(FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K))*DXYIP(L) + VVV(L,K)=QQL(L,K)*H1P(L)*H1P(L) + & +DELT*(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + & +(FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K))*DXYIP(L) + + UUU(L,K)=MAX(UUU(L,K),0.) + VVV(L,K)=MAX(VVV(L,K),0.) + ELSE + UUU(L,K)=0.0 + VVV(L,K)=0.0 + ENDIF + ENDDO + ENDDO +C + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQ,PQQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)*(U(L+1,K+1)-U(L+1,K)+U(L,K+1) + & -U(L,K))**2+AV(L,K)*DZIGSD4(K)*(V(LN,K+1)-V(LN,K) + & +V(L,K+1)-V(L,K))**2 + PQQ=DELT*(PQQB+PQQU) + UUU(L,K)=UUU(L,K)+2.*PQQ + PQQL=DELT*H1P(L)*(CTE3*PQQB+CTE1*PQQU) + VVV(L,K)=VVV(L,K)+DML(L,K)*PQQL + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(506)=MPI_WTIMES(506)+MPI_TOC(S1TIME) +C +C *** DSLLC BEGIN BLOCK +C + S1TIME=MPI_TIC() + IF(ISWAVE.EQ.2)THEN + IF(N.LT.NTSWV)THEN + TMPVAL=FLOAT(N)/FLOAT(NTSWV) + WVFACT=0.5-0.5*COS(PI*TMPVAL) + ELSE + WVFACT=1.0 + ENDIF + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1W(L,K)=WVDTKEM(K)*WVDISP(L,K)+WVDTKEP(K)*WVDISP(L,K+1) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LS,PQQB,PQQU,PQQV,PQQW,PQQ,PQQL,FFTMP) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + PQQB=AB(L,K)*GP*HP(L)*DZIG(K)*(B(L,K+1)-B(L,K)) + PQQU=AV(L,K)*DZIGSD4(K)* + & (U(L+1,K+1)-U(L+1,K)+U(L,K+1)-U(L,K))**2 + PQQV=AV(L,K)*DZIGSD4(K)* + & (V(LN,K+1)-V(LN,K)+V(L,K+1)-V(L,K))**2 + PQQW= WVFACT*TVAR1W(L,K) + PQQ=DELT*(PQQU+PQQV+PQQB+PQQW) + FFTMP=MAX(FUHU(L,K)-FUHU(L+1,K)+FVHU(L,K)-FVHU(LN,K) + + & (FWQQ(L,K)-FWQQ(L,K+1))*DZIG(K),0.) + UUU(L,K)=QQ(L,K)*H1P(L)+DELT*FFTMP*DXYIP(L) + 2.*PQQ + PQQL=DELT*H1P(L)*(CTE3*PQQB+CTE1*(PQQU+PQQV+PQQW)) + FFTMP=MAX(FUHV(L,K)-FUHV(L+1,K)+FVHV(L,K)-FVHV(LN,K) + + & (FWQQL(L,K)-FWQQL(L,K+1))*DZIG(K),0.) + VVV(L,K)=QQL(L,K)*H1P(L)*H1P(L)+DELT*FFTMP*DXYIP(L) + + & DML(L,K)*PQQL + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(507)=MPI_WTIMES(507)+MPI_TOC(S1TIME) +C +C *** DSLLC END BLOCK +C + S1TIME=MPI_TIC() + IF(KC.LE.2)THEN + IF(IDRYTBP.EQ.0)THEN +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0) + & -CUQTMP*HP(L)*QQ(L,KC))*EQ + VVV(L,1)=VVV(L,1)*EQL + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0) + & -CUQTMP*HP(L)*QQ(L,KC))*EQ + VVV(L,1)=VVV(L,1)*EQL + ENDIF + ENDDO + ENDIF + ENDIF + MPI_WTIMES(508)=MPI_WTIMES(508)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(KC.GT.2)THEN + IF(IDRYTBP.EQ.0)THEN +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0))*EQ + VVV(L,1)=VVV(L,1)*EQL + CUQTMP=-DELT*CDZKKP(KS)*AQ(L,KC)*HPI(L) + UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) + ENDDO + DO K=2,KS +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) + CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)))*(1. + & +CTE2*DML(L,K)*DML(L,K)*FPROX(K)) + EQ=1./(CMQTMP-CLQTMP*CU1(L,K-1)) + EQL=1./(CMQLTMP-CLQTMP*CU2(L,K-1)) + CU1(L,K)=CUQTMP*EQ + CU2(L,K)=CUQTMP*EQL + UUU(L,K)=(UUU(L,K)-CLQTMP*UUU(L,K-1))*EQ + VVV(L,K)=(VVV(L,K)-CLQTMP*VVV(L,K-1))*EQL + ENDDO + ENDDO + DO K=KS-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) + VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) + ENDDO + ENDDO + ELSE +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(1)*AQ(L,1)*HPI(L) + CUQTMP=-DELT*CDZKKP(1)*AQ(L,2)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,1)/(CTURBB1(L,1)*DML(L,1)*HP(L)))*(1. + & +CTE2*DML(L,1)*DML(L,1)*FPROX(1)) + EQ=1./CMQTMP + EQL=1./CMQLTMP + CU1(L,1)=CUQTMP*EQ + CU2(L,1)=CUQTMP*EQL + UUU(L,1)=(UUU(L,1)-CLQTMP*HP(L)*QQ(L,0))*EQ + VVV(L,1)=VVV(L,1)*EQL + CUQTMP=-DELT*CDZKKP(KS)*AQ(L,KC)*HPI(L) + UUU(L,KS)=UUU(L,KS)-CUQTMP*HP(L)*QQ(L,KC) + ENDIF + ENDDO + DO K=2,KS +!$OMP PARALLEL DO PRIVATE(CLQTMP,CUQTMP,CMQTMP,CMQLTMP,EQ,EQL) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CLQTMP=-DELT*CDZKK(K)*AQ(L,K)*HPI(L) + CUQTMP=-DELT*CDZKKP(K)*AQ(L,K+1)*HPI(L) + CMQTMP=1.-CLQTMP-CUQTMP + & +2.*DELT*QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + CMQLTMP=1.-CLQTMP-CUQTMP + & +DELT*(QQSQR(L,K)/(CTURBB1(L,K)*DML(L,K)*HP(L)) + & )*(1.+CTE2*DML(L,K)*DML(L,K)*FPROX(K)) + EQ=1./(CMQTMP-CLQTMP*CU1(L,K-1)) + EQL=1./(CMQLTMP-CLQTMP*CU2(L,K-1)) + CU1(L,K)=CUQTMP*EQ + CU2(L,K)=CUQTMP*EQL + UUU(L,K)=(UUU(L,K)-CLQTMP*UUU(L,K-1))*EQ + VVV(L,K)=(VVV(L,K)-CLQTMP*VVV(L,K-1))*EQL + ENDIF + ENDDO + ENDDO + DO K=KS-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) + VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(509)=MPI_WTIMES(509)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'UUU = ', sum(abs(dble(UUU))) + PRINT*, n,'VVV = ', sum(abs(dble(VVV))) + ENDIF + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'1QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'1QQL = ', sum(abs(dble(QQL))) + ENDIF + ENDIF +C + S1TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH) + DO L=LMPI2,LMPILA + QQ1(L,K)=QQ(L,K) + QQHDH=UUU(L,K)*HPI(L) + QQ(L,K)=MAX(QQHDH,QQMIN) + ENDDO + ENDDO +C +C ** ORIGINAL FORM MODIFED FOR DIMENSIONAL LENGHT SCALE TRANSPORT +C + IF(ISTOPT(0).EQ.1)THEN + DO K=1,KS +!!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP,DELB,DMLMAX) + DO L=LMPI2,LMPILA + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DMLTMP=MAX(DMLTMP,DMLMIN) + DELB=B(L,K)-B(L,K+1) + IF(DELB.GT.0.0)THEN + DMLMAX=0.53*SQRT(QQ(L,K)/(G*HP(L)*DZIG(K)*DELB)) + DML(L,K)=MIN(DMLMAX,DMLTMP) + ELSE + DML(L,K)=DMLTMP + ENDIF + ENDDO + ENDDO + ENDIF +C +C ** BUCHARD'S MODIFED CLOSURE FOR DIMENSIONAL LENGHT SCALE TRANSPORT +C + IF(ISTOPT(0).EQ.2)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP) + DO L=LMPI2,LMPILA + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DML(L,K)=MAX(DMLTMP,DMLMIN) + ENDDO + ENDDO + ENDIF + ELSE + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQ1(L,K)=QQ(L,K) + QQHDH=UUU(L,K)*HPI(L) + QQ(L,K)=MAX(QQHDH,QQMIN) + ENDIF + ENDDO + ENDDO +C +C ** ORIGINAL FORM MODIFED FOR DIMENSIONAL LENGHT SCALE TRANSPORT +C + IF(ISTOPT(0).EQ.1)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP,DELB,DMLMAX) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DMLTMP=MAX(DMLTMP,DMLMIN) + DELB=B(L,K)-B(L,K+1) + IF(DELB.GT.0.0)THEN + DMLMAX=0.53*SQRT(QQ(L,K)/(G*HP(L)*DZIG(K)*DELB)) + DML(L,K)=MIN(DMLMAX,DMLTMP) + ELSE + DML(L,K)=DMLTMP + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF +C +C ** BUCHARD'S MODIFED CLOSURE FOR DIMENSIONAL LENGHT SCALE TRANSPORT +C + IF(ISTOPT(0).EQ.2)THEN + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(QQHDH,DMLTMP) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + QQL1(L,K)=QQL(L,K) + QQHDH=VVV(L,K)*HPI(L)*HPI(L) + QQL(L,K)=MAX(QQHDH,QQLMIN) + DMLTMP=QQL(L,K)/QQ(L,K) + DML(L,K)=MAX(DMLTMP,DMLMIN) + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(510)=MPI_WTIMES(510)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'2QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'2QQL = ', sum(abs(dble(QQL))) + ENDIF + ENDIF +C +C QQMXSV=-1.E+12 +C QQMNSV=1.E+12 +C QQLMXSV=-1.E+12 +C QQLMNSV=1.E+12 +C + S1TIME=MPI_TIC() + DO K=1,KS + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + QQ(L,K)=QQ(LN,K) + QQL(L,K)=QQL(LN,K) + DML(L,K)=DML(LN,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBW + L=LCBW(LL) + QQ(L,K)=QQ(L+1,K) + QQL(L,K)=QQL(L+1,K) + DML(L,K)=DML(L+1,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBE + L=LCBE(LL) + QQ(L,K)=QQ(L-1,K) + QQL(L,K)=QQL(L-1,K) + DML(L,K)=DML(L-1,K) + ENDDO + ENDDO + DO K=1,KS + DO LL=1,NCBN + L=LCBN(LL) + LS=LSC(L) + QQ(L,K)=QQ(LS,K) + QQL(L,K)=QQL(LS,K) + DML(L,K)=DML(LS,K) + ENDDO + ENDDO +C *** DSLLC BEGIN BLOCK + MPI_WTIMES(511)=MPI_WTIMES(511)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + QQSQR(L,K)=SQRT(QQ(L,K)) ! *** DSLLC + ENDDO + ENDDO + MPI_WTIMES(512)=MPI_WTIMES(512)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=0,KCM + CALL broadcast_boundary(QQ(:,K),ic) + CALL broadcast_boundary(QQ1(:,K),ic) + CALL broadcast_boundary(QQL(:,K),ic) + CALL broadcast_boundary(QQL1(:,K),ic) + CALL broadcast_boundary(QQSQR(:,K),ic) + CALL broadcast_boundary(DML(:,K),ic) + ENDDO + MPI_WTIMES(515)=MPI_WTIMES(515)+MPI_TOC(S1TIME) +C + IF(PRINT_SUM)THEN + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + call collect_in_zero(QQL(:,K)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'3QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'3QQL = ', sum(abs(dble(QQL))) + ENDIF + ENDIF + call mpi_barrier(mpi_comm_world,ierr) +C +C *** DSLLC END BLOCK +C 110 FORMAT(' I J QQ BOT QQ MID QQ SURF', +C & ' PROD+ADV 1./DIAGON') +C 111 FORMAT(2I5,5E14.5) +C 600 FORMAT('N,QX,QN,QLX,QLN,CX,CN=',I5,6E12.4) +C 601 FORMAT('NEG QQ I,J,K,QQ=',3I5,E13.5) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS_mpi.for new file mode 100644 index 000000000..37e6e73a8 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALQVS_mpi.for @@ -0,0 +1,753 @@ + SUBROUTINE CALQVS_mpi (ISTL_) +C +C CHANGE RECORD +C ** SUBROUTINE CALQVS UPDATES TIME VARIABLE VOLUME SOURCES +C + USE GLOBAL + USE MPI + + REAL T1TMP,T2TMP + INTEGER*4 NS + + ! *** PMC + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + END IF + ELSE + DELT=DT2 + ENDIF + ! *** PMC +C +C ** INITIALIZE NULL (0) FLOW SERIES +C + S1TIME=MPI_TIC() +C + GWSERT(0)=0. + QWRSERT(0)=0. + QSERTCELL=0.0 + DO K=1,KC + QSERT(K,0)=0. + QCTLT(K,0)=0. + QCTLTO(K,0)=0. + ENDDO + + IF(NGWSER.GE.1)THEN + NCTMP=4+NSED+NSND+NTOX + DO NC=1,NCTMP + GWCSERT(0,NC)=0. + ENDDO + + DO L=2,LA + QGW(L)=0.0 + END DO + IF(ISTRAN(5).GT.0)THEN + DO NC=1,NCTMP + DO L=2,LA + CONGW(L,NC)=0.0 + END DO + END DO + ENDIF + ENDIF +C +C ** INITIALIZE TOTAL FLOW SERIES +C + DO L=1,LC + QSUM1E(L)=QSUME(L) ! *** DSLLC SINGLE LINE + QSUME(L)=0. + ENDDO + + ! *** SELECTIVE ZEROING + IF(KC.GT.1)THEN + IF(NGWSER.GT.0.OR.ISGWIT.NE.0)THEN + DO L=1,LC + QSUM(L,1)=0. + ENDDO + ENDIF + + ! *** ZERO EVAP/RAINFALL + DO L=1,LC + QSUM(L,KC)=0. + ENDDO + + ! *** ZERO ALL DEFINED BC'S + DO NS=1,NBCS + L=LBCS(NS) + DO K=1,KC + QSUM(L,K)=0. + ENDDO + ENDDO + + ELSE + ! *** SINGLE LAYER + DO L=1,LC + QSUM(L,1)=0. + ENDDO + ENDIF +C + MPI_WTIMES(1201)=MPI_WTIMES(1201)+MPI_TOC(S1TIME) +C +C ** VOLUME SOURCE/SINK INTERPOLATION +C + S1TIME=MPI_TIC() +C + DO NS=1,NQSER + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*(FLOAT(N)-0.5)/TCQSER(NS) + & +TBEGIN*(TCON/TCQSER(NS)) + ELSE + CTIM=TIMESEC/TCQSER(NS) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*FLOAT(N-1)/TCQSER(NS)+TBEGIN*(TCON/TCQSER(NS)) + ELSE + CTIM=TIMESEC/TCQSER(NS) + ENDIF + ENDIF + M1=MQTLAST(NS) + 100 CONTINUE + M2=M1+1 +! IF(M2.GT.NDQSER)THEN + IF(CTIM.GT.TQSER(M2,NS))THEN + M1=M2 + GOTO 100 +! ENDIF + ELSE + MQTLAST(NS)=M1 + ENDIF + TDIFF=TQSER(M2,NS)-TQSER(M1,NS) + WTM1=(TQSER(M2,NS)-CTIM)/TDIFF + WTM2=(CTIM-TQSER(M1,NS))/TDIFF + DO K=1,KC + QSERT(K,NS)=WTM1*QSER(M1,K,NS)+WTM2*QSER(M2,K,NS) + ENDDO + ENDDO + IF(N.EQ.1)THEN + DO LL=1,NQSIJ + L=LQS(LL) + ITYP=LCT(L) + IF(ITYP.LE.0.OR.ITYP.GE.8)THEN + IF(MYRANK.EQ.0) WRITE(6,6111)LL,IQS(LL),JQS(LL) + IF(MYRANK.EQ.0) WRITE(8,6111)LL,IQS(LL),JQS(LL) + ENDIF + ENDDO + ENDIF + DO LL=1,NQSIJ + NS=NQSERQ(LL) + L=LQS(LL) + DO K=1,KC + ! *** PMC START + ! *** APPLY MULTIPLIERS HERE TO CORRECT MASS BALANCE PROBLEMS + QSS(K,LL) =QSS(K,LL) *RQSMUL(LL) + QSERCELL(K,LL)=QSERT(K,NS)*RQSMUL(LL)*QFACTOR(LL) + QSUM(L,K)=QSUM(L,K)+QSS(K,LL)+QSERCELL(K,LL) + ! *** PMC END + ENDDO + ENDDO +C + MPI_WTIMES(1202)=MPI_WTIMES(1202)+MPI_TOC(S1TIME) +C +C ** GROUNDWATER SOURCE/SINK INTERPOLATION +C + S1TIME=MPI_TIC() +C + IF(NGWSER.GE.1)THEN + NCTMP=4+NSED+NSND+NTOX + DO NS=1,NGWSER + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*(FLOAT(N)-0.5)/TCGWSER(NS) + & +TBEGIN*(TCON/TCGWSER(NS)) + ELSE + CTIM=TIMESEC/TCGWSER(NS) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*FLOAT(N-1)/TCQSER(NS)+TBEGIN*(TCON/TCQSER(NS)) + ELSE + CTIM=TIMESEC/TCGWSER(NS) + ENDIF + ENDIF + M1=MGWTLAST(NS) + 700 CONTINUE + M2=M1+1 + IF(CTIM.GT.TGWSER(M2,NS))THEN + M1=M2 + GOTO 700 + ELSE + MGWTLAST(NS)=M1 + ENDIF + TDIFF=TGWSER(M2,NS)-TGWSER(M1,NS) + WTM1=(TGWSER(M2,NS)-CTIM)/TDIFF + WTM2=(CTIM-TGWSER(M1,NS))/TDIFF + GWSERT(NS)=WTM1*GWSER(M1,NS)+WTM2*GWSER(M2,NS) + DO NC=1,NCTMP + GWCSERT(NC,NS)=WTM1*GWCSER(M1,NC,NS)+WTM2*GWCSER(M2,NC,NS) + END DO + ENDDO + DO L=2,LA + QGW(L)=GWFAC(L)*GWSERT(NGWSL(L)) + END DO + IF(ISTRAN(5).GT.0)THEN + DO NC=1,NCTMP + DO L=2,LA + CONGW(L,NC)=GWCSERT(NC,NGWSL(L)) + END DO + END DO + ENDIF + ENDIF +C + MPI_WTIMES(1203)=MPI_WTIMES(1203)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C + ! *** CONSTANT GW LOSSES + IF(ISGWIT.EQ.3)THEN + DO L=2,LA + IF(H1P(L).GE.HDRY)THEN + !VOLOUTO=VOLOUTO+RIFTR(L)*DTIM + QSUM(L,1)=QSUM(L,1)-RIFTR(L) + ENDIF + ENDDO + !IF((H1P(343).GE.HDRY.or.HP(343).GE.HDRY).and.TIMEDAY.GT.6.5)THEN + ! VOLOUTE=VOLOUTE+RIFTR(L)*DTIM + ! WRITE(99,*)N,TIMEDAY,RIFTR(L),H1P(L),HP(L),VOLOUTE + !ENDIF + ENDIF +C + MPI_WTIMES(1204)=MPI_WTIMES(1204)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C ** CONTROL STRUCTURES AND TIDAL INLETS +C + CALL CPU_TIME(T1TMP) + DO NCTL=1,NQCTL + IF(NQCTYP(NCTL).LE.1)THEN + NCTLT=NQCTLQ(NCTL) + RQDW=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + HUP=HP(LU)+BELV(LU)+HCTLUA(NCTLT) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=LC + HDW=0. + RQDW=0. + ELSE + LD=LIJ(ID,JD) + HDW=HP(LD)+BELV(LD)+HCTLDA(NCTLT) + ENDIF + DELH=HCTLUM(NCTLT)*HUP-HCTLDM(NCTLT)*HDW + IF(NQCTYP(NCTL).EQ.0.AND.AQCTL(NCTLT).GT.0.0)THEN + IF(HUP.LT.AQCTL(NCTLT)) DELH=-100. + ENDIF + IF(DELH.LE.0.OR.HP(LU).LT.HWET)THEN + DO K=1,KC + QCTLT(K,NCTL)=0. + ENDDO + ELSE + IF(NQCTYP(NCTL).EQ.1)DELH=SQRT(DELH) + M1=0 + M2=1 + 500 M1=M1+1 + M2=M2+1 + IF(M2.GT.MQCTL(NCTLT).AND.MYRANK.EQ.0)THEN + WRITE(6,6666) + WRITE(6,6667)NCTL,NCTLT,IU,JU,ID,JD + WRITE(6,6668)HUP,HP(LU),HDW,HP(LD) + WRITE(8,6666) + WRITE(8,6667)NCTL,NCTLT,IU,JU,ID,JD + WRITE(8,6668)HUP,HP(LU),HDW,HP(LD) + STOP + ENDIF + IF(DELH.GE.HDIFCTL(M1,NCTLT).AND.DELH.LE.HDIFCTL(M2,NCTLT) + & )THEN + TDIFF=HDIFCTL(M2,NCTLT)-HDIFCTL(M1,NCTLT) + WTM1=(HDIFCTL(M2,NCTLT)-DELH)/TDIFF + WTM2=(DELH-HDIFCTL(M1,NCTLT))/TDIFF + DO K=1,KC + QCTLT(K,NCTL)=WTM1*QCTL(M1,1,K,NCTLT) + & +WTM2*QCTL(M2,1,K,NCTLT) + ENDDO + ELSE + GOTO 500 + ENDIF + ENDIF + IF(NQCTYP(NCTL).EQ.1)THEN + IF(ISTL_.EQ.3)THEN + DO K=1,KC + QCTLST(K,NCTL)=QCTLT(K,NCTL) + TMPVAL=QCTLTO(K,NCTL) + & +DT*AQCTL(NCTLT)*QCTLST(K,NCTL)*QCTLST(K,NCTL) + QCTLT(K,NCTL)=TMPVAL/(1.+DT*AQCTL(NCTLT)*QCTLTO(K,NCTL)) + QCTLTO(K,NCTL)=QCTLT(K,NCTL) + QCTLSTO(K,NCTL)=QCTLST(K,NCTL) + ENDDO + ELSE + DO K=1,KC + QCTLST(K,NCTL)=QCTLT(K,NCTL) + TMPVAL=QCTLTO(K,NCTL) + & +DT*AQCTL(NCTLT)*QCTLST(K,NCTL)*QCTLST(K,NCTL) + QCTLT(K,NCTL)=TMPVAL/(1.+DT*AQCTL(NCTLT)*QCTLTO(K,NCTL)) + QCTLT(K,NCTL)=0.5*(QCTLT(K,NCTL)+QCTLTO(K,NCTL)) + ENDDO + ENDIF + ENDIF + QCTLMAX=(HP(LU)-HDRY)*DXYP(LU)/(DELT*FLOAT(KC)) + DO K=1,KC + QCTLT(K,NCTL)=MIN(QCTLT(K,NCTL),QCTLMAX) + ENDDO + DO K=1,KC + ! *** PMC START - CORRECTED VOLUME MULTIPLIER TO FIX MASS BALANCE PROBLEM + QCTLT(K,NCTL)=QCTLT(K,NCTL)*RQCMUL(NCTL) + QSUM(LU,K)=QSUM(LU,K)-QCTLT(K,NCTL) + QSUM(LD,K)=QSUM(LD,K)+QCTLT(K,NCTL)*RQDW + ! *** PMC END + ENDDO + IPMC=0 + ENDIF + ENDDO +C + MPI_WTIMES(1205)=MPI_WTIMES(1205)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C + DO NCTL=1,NQCTL + IF(NQCTYP(NCTL).EQ.2)THEN + NCTLT=NQCTLQ(NCTL) + RQDW=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LU=LIJ(IU,JU) + HUP=HP(LU)+BELV(LU)+HCTLUA(NCTLT) + IF(HUP.LT.HDIFCTL(1,NCTLT).OR.HP(LU).LT.HWET)THEN + DO K=1,KC + QCTLT(K,NCTL)=0. + ENDDO + GOTO 560 + ENDIF + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + LD=LIJ(ID,JD) + HDW=HP(LD)+BELV(LD)+HCTLDA(NCTLT) + HTMPD=HDIFCTD(1,NCTLT)+0.001 + HDW=MAX(HDW,HTMPD) + MU1=0 + MU2=1 + MD1=0 + MD2=1 + 555 MU1=MU1+1 + MU2=MU1+1 + IF(MU2.GT.MQCTL(NCTLT).AND.MYRANK.EQ.0)THEN + WRITE(6,6676) + WRITE(6,6677)NCTL,NCTLT,IU,JU,ID,JD + WRITE(6,6678)HUP,HP(LU),HDW,HP(LD) + WRITE(6,6679)HDIFCTL(1,NCTLT),HDIFCTL(MQCTL(NCTLT),NCTLT), + & HDIFCTD(1,NCTLT),HDIFCTD(MQCTL(NCTLT),NCTLT) + WRITE(8,6676) + WRITE(8,6677)NCTL,NCTLT,IU,JU,ID,JD + WRITE(8,6678)HUP,HP(LU),HDW,HP(LD) + WRITE(8,6679)HDIFCTL(1,NCTLT),HDIFCTL(MQCTL(NCTLT),NCTLT), + & HDIFCTD(1,NCTLT),HDIFCTD(MQCTL(NCTLT),NCTLT) + STOP + ENDIF + IF(HUP.GE.HDIFCTL(MU1,NCTLT).AND.HUP.LE.HDIFCTL(MU2,NCTLT))THEN + TDIFFU=HDIFCTL(MU2,NCTLT)-HDIFCTL(MU1,NCTLT) + WTM1U=(HDIFCTL(MU2,NCTLT)-HUP)/TDIFFU + WTM2U=(HUP-HDIFCTL(MU1,NCTLT))/TDIFFU + ELSE + GOTO 555 + ENDIF + 556 MD1=MD1+1 + MD2=MD1+1 + IF(MD2.GT.MQCTL(NCTLT).AND.MYRANK.EQ.0)THEN + WRITE(6,6686) + WRITE(6,6687)NCTL,NCTLT,IU,JU,ID,JD + WRITE(6,6688)HUP,HP(LU),HDW,HP(LD) + WRITE(6,6679)HDIFCTL(1,NCTLT),HDIFCTL(MQCTL(NCTLT),NCTLT), + & HDIFCTD(1,NCTLT),HDIFCTD(MQCTL(NCTLT),NCTLT) + WRITE(8,6686) + WRITE(8,6687)NCTL,NCTLT,IU,JU,ID,JD + WRITE(8,6688)HUP,HP(LU),HDW,HP(LD) + WRITE(8,6679)HDIFCTL(1,NCTLT),HDIFCTL(MQCTL(NCTLT),NCTLT), + & HDIFCTD(1,NCTLT),HDIFCTD(MQCTL(NCTLT),NCTLT) + STOP + ENDIF + IF(HDW.GE.HDIFCTD(MD1,NCTLT).AND.HDW.LE.HDIFCTD(MD2,NCTLT))THEN + TDIFFD=HDIFCTD(MD2,NCTLT)-HDIFCTD(MD1,NCTLT) + WTM1D=(HDIFCTD(MD2,NCTLT)-HDW)/TDIFFD + WTM2D=(HDW-HDIFCTD(MD1,NCTLT))/TDIFFD + ELSE + GOTO 556 + ENDIF + DO K=1,KC + QCTLT(K,NCTL)=WTM1U*( WTM1D*QCTL(MU1,MD1,K,NCTLT) + & +WTM2D*QCTL(MU1,MD2,K,NCTLT) ) + & +WTM2U*( WTM1D*QCTL(MU2,MD1,K,NCTLT) + & +WTM2D*QCTL(MU2,MD2,K,NCTLT) ) + ENDDO + 560 CONTINUE + QCTLMAX=(HP(LU)-HDRY)*DXYP(LU)/(DELT*FLOAT(KC)) + DO K=1,KC + QCTLT(K,NCTL)=MIN(QCTLT(K,NCTL),QCTLMAX) + ENDDO + DO K=1,KC + ! *** PMC START - CORRECTED VOLUME MULTIPLIER TO FIX MASS BALANCE PROBLEM + QCTLT(K,NCTL)=QCTLT(K,NCTL)*RQCMUL(NCTL) + QSUM(LU,K)=QSUM(LU,K)-QCTLT(K,NCTL) + QSUM(LD,K)=QSUM(LD,K)+QCTLT(K,NCTL)*RQDW + ! *** PMC END + ENDDO + ENDIF + ENDDO +C { GEOSR 2010.5.6 GATE NORMAL FORMULA + MPI_WTIMES(1206)=MPI_WTIMES(1206)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C + IF (NQCTL.GE.1) THEN + IF (NQCTYP(1).GE.3) THEN + CALL CGATEFLX + ENDIF + ENDIF +C + MPI_WTIMES(1207)=MPI_WTIMES(1207)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C } GEOSR 2010.5.6 GATE NORMAL FORMULA + CALL CPU_TIME(T2TMP) + TQCTL=TQCTL+T2TMP-T1TMP +C +C ** FLOW WITHDRAWAL AND RETURN +C + NTMP=4+NSED+NSND+NTOX + IF(ISTRAN(8).GT.0)NTMP=NTMP+NWQV + + DO NC=1,NTMP + CQWRSERT(0,NC)=0. + ENDDO + DO NS=1,NQWRSR + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*(FLOAT(N)-0.5)/TCQWRSR(NS) + & +TBEGIN*(TCON/TCQWRSR(NS)) + ELSE + CTIM=TIMESEC/TCQWRSR(NS) + ENDIF + ELSE + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*FLOAT(N-1)/TCQWRSR(NS)+TBEGIN*(TCON/TCQWRSR(NS)) + ELSE + CTIM=TIMESEC/TCQWRSR(NS) + ENDIF + ENDIF + M1=MQWRTLST(NS) + 200 CONTINUE + M2=M1+1 + IF(CTIM.GT.TQWRSER(M2,NS))THEN + M1=M2 + GOTO 200 + ELSE + MQWRTLST(NS)=M1 + ENDIF + TDIFF=TQWRSER(M2,NS)-TQWRSER(M1,NS) + WTM1=(TQWRSER(M2,NS)-CTIM)/TDIFF + WTM2=(CTIM-TQWRSER(M1,NS))/TDIFF + QWRSERT(NS)=WTM1*QWRSER(M1,NS)+WTM2*QWRSER(M2,NS) + DO NC=1,NTMP + CQWRSERT(NS,NC)=WTM1*CQWRSER(M1,NS,NC)+WTM2*CQWRSER(M2,NS,NC) + ENDDO + ENDDO +C + MPI_WTIMES(1208)=MPI_WTIMES(1208)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C + IF(NQWR.GT.0)THEN + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NS=NQWRSERQ(NWR) + QSUM(LU,KU)=QSUM(LU,KU)-QWR(NWR)-QWRSERT(NS) + QSUM(LD,KD)=QSUM(LD,KD)+QWR(NWR)+QWRSERT(NS) + ENDDO + ENDIF +C + MPI_WTIMES(1209)=MPI_WTIMES(1209)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C ** CALL JPEFDC AND PLACE JET-PLUME VOLUMES SOURCES +C + IF(NQJPIJ.GT.0.AND.N.EQ.1) CALL JPEFDC + IF(NQJPIJ.GT.0.AND.ISTL_.EQ.3)THEN + IF(NUDJPC(1).EQ.NUDJP(1))THEN + CALL JPEFDC + NUDJPC(1)=1 + ELSE + NUDJPC(1)=NUDJPC(1)+1 + ENDIF + ENDIF + IF(NQJPIJ.GT.0.AND.IS2TIM.GE.1)THEN + IF(NUDJPC(1).EQ.NUDJP(1))THEN + CALL JPEFDC + NUDJPC(1)=1 + ELSE + NUDJPC(1)=NUDJPC(1)+1 + ENDIF + ENDIF +C + MPI_WTIMES(1210)=MPI_WTIMES(1210)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C ** PLACE JET-PLUME VOLUMES SOURCES +C + IF(NQJPIJ.GT.0)THEN + DO NJP=1,NQJPIJ + IF(ICALJP(NJP).EQ.1)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) +C +C QVJPTMP = JETPLUME DISCHARGE PER PORT +C + QVJPTMP=QQCJP(NJP) + DO K=1,KC + QVJPTMP=QVJPTMP+QSERT(K,NQSERJP(NJP)) + ENDDO +C +C SUBTRACT THE ENTRAINMENT FROM EACH LAYER +C + DO K=1,KC + QSUM(LJP,K)=QSUM(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO +C +C PLACE DISCHARGE AND TOTAL ENTRAINMENT AT EFFECTIVE LOCATION +C + QSUM(LJP,KTMP)=QSUM(LJP,KTMP)+RPORTS*(QVJPTMP+QJPENTT(NJP)) + ENDIF + IF(ICALJP(NJP).EQ.2)THEN + RPORTS=FLOAT(NPORTJP(NJP)) + LJP=LIJ(IQJP(NJP),JQJP(NJP)) + KTMP=KEFFJP(NJP) +C +C QVJPTMP = JETPLUME DISCHARGE PER PORT +C + QVJPTMP=QWRCJP(NJP)+QWRSERT(NQWRSERJP(NJP)) +C +C SUBTRACT ENTRAIMENT FROM EACH LAYER +C + DO K=1,KC + QSUM(LJP,K)=QSUM(LJP,K)-RPORTS*QJPENT(K,NJP) + ENDDO +C +C PLACE DISCHARGE AND TOTAL ENTRAINMENT AT EFFECTIVE LOCATION +C + QSUM(LJP,KTMP)=QSUM(LJP,KTMP)+RPORTS*(QVJPTMP+QJPENTT(NJP)) +C +C REMOVE DISCHARGE FROM UPSTREAM INTAKE CELL +C + LU=LIJ(IUPCJP(NJP),JUPCJP(NJP)) + KU=KUPCJP(NJP) + QSUM(LU,KU)=QSUM(LU,KU)-RPORTS*QVJPTMP + ENDIF + ENDDO + ENDIF +C + MPI_WTIMES(1211)=MPI_WTIMES(1211)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C ** GROUND WATER INTERACTION, EVAPORATION AND RAINFALL +C + IF(ISGWIE.EQ.0)THEN + IF(EVAPCVT.LT.0.)THEN + DO L=2,LA + SVPW=(10.**((0.7859+0.03477*TEM(L,KC))/ + & (1.+0.00412*TEM(L,KC)))) + EVAPT(L)=CLEVAP(L)*0.7464E-3*WINDST(L)*(SVPW-VPA(L))/PATMT(L) + IF(HP(L).LT.HWET) EVAPT(L)=0. + QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*(RAINT(L)-EVAPT(L)) + ENDDO + ELSE + DO L=2,LA + IF(HP(L).LT.HWET) EVAPT(L)=0. + QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*(RAINT(L)-EVAPT(L)) + ENDDO + ENDIF + ELSE + DO L=2,LA + QSUM(L,KC)=QSUM(L,KC)+DXYP(L)*RAINT(L) + ENDDO + ENDIF +C +C ** DETERMINE NET EXTERNAL VOLUME SOURCE/SINK +C + DO K=1,KC + DO L=1,LC + QSUME(L)=QSUME(L)+QSUM(L,K) + ENDDO + ENDDO +C + MPI_WTIMES(1212)=MPI_WTIMES(1212)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +C +C ** UPDATE ZERO DIMENSION VOLUME BALANCE +C VOLADD=0. +C ** WRITE DIAGNOSTIC FILE FOR VOLUME SOURCES,SINKS, ETC +C + ITMPD=0 + IF(ISDIQ.EQ.2.AND.ISTL_.EQ.2) ITMPD=1 + IF(ISDIQ.EQ.1) ITMPD=1 + NTT=4+NTOX+NSED+NSND + IF(ITMPD.EQ.1.AND.DEBUG)THEN + IF(MYRANK.EQ.0)THEN + IF(N.EQ.NTSPTC.OR.N.EQ.1)THEN + OPEN(1,FILE='QDIAG.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='QDIAG1.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='QDIAG1.OUT',STATUS='UNKNOWN') + ELSE + OPEN(1,FILE='QDIAG.OUT',POSITION='APPEND',STATUS='UNKNOWN') + ENDIF + WRITE(1,101)N + DO LL=1,NQSIJ + NQSTMP=NQSERQ(LL) + NCSTMP=NCSERQ(LL,1) + L=LQS(LL) + I=IL(L) + J=JL(L) + WRITE(1,102)I,J + WRITE(1,216)LL,L,(QSS(K,LL),K=1,KC) + DO NT=1,NTT + WRITE(1,217)LL,NT,(CQS(K,LL,NT),K=1,KC) + ENDDO + WRITE(1,104) + WRITE(1,105)I,J + WRITE(1,206)LL,L,(QSERCELL(K,LL),K=1,KC) + DO NT=1,NTT + NCSTMP=NCSERQ(LL,NT) + WRITE(1,207)LL,NT,NCSTMP,(CSERT(K,NCSTMP,NT),K=1,KC) + ENDDO + WRITE(1,104) + ENDDO + DO NCTL=1,NQCTL + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + NCTLT=NQCTLQ(NCTL) + IF(IU.EQ.0.AND.JU.EQ.0)THEN + LU=0 + HUP=0. + ELSE + LU=LIJ(IU,JU) + HUP=HP(LU)+BELV(LU)+HCTLUA(NCTLT) + ENDIF + IF(ID.EQ.0.AND.JD.EQ.0)THEN + LD=0 + HDW=0. + ELSE + LD=LIJ(ID,JD) + HDW=HP(LD)+BELV(LD)+HCTLDA(NCTLT) + ENDIF + WRITE(1,107)IU,JU,LU,NCTLT,HUP + DO K=1,KC + WRITE(1,108)K,QCTLT(K,NCTL) + ENDDO + WRITE(1,104) + WRITE(1,109)ID,JD,LD,NCTLT,HDW + DO K=1,KC + WRITE(1,108)K,QCTLT(K,NCTL) + ENDDO + WRITE(1,104) + ENDDO + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + KU=KQWRU(NWR) + ID=IQWRD(NWR) + JD=JQWRD(NWR) + KD=KQWRD(NWR) + LU=LIJ(IU,JU) + LD=LIJ(ID,JD) + NQSTMP=NQWRSERQ(NWR) + WRITE(1,110)IU,JU + WRITE(1,111)KU,QWR(NWR),CQWR(NWR,1),CQWR(NWR,2) + WRITE(1,104) + WRITE(1,112)ID,JD + WRITE(1,111)KD,QWR(NWR),CQWR(NWR,1),CQWR(NWR,2) + WRITE(1,104) + WRITE(1,113)IU,JU + WRITE(1,114)KU,QWRSERT(NQSTMP),CQWRSERT(NQSTMP,1), + & CQWRSERT(NQSTMP,2) + WRITE(1,104) + WRITE(1,115)ID,JD + WRITE(1,114)KD,QWRSERT(NQSTMP),CQWRSERT(NQSTMP,1), + & CQWRSERT(NQSTMP,2) + WRITE(1,104) + ENDDO + CLOSE(1) + ENDIF + ENDIF +C + MPI_WTIMES(1213)=MPI_WTIMES(1213)+MPI_TOC(S1TIME) +C + 101 FORMAT(' SOURCE/SINK DIAGNOSTICS AT TIME STEP =',I8,//) + 102 FORMAT(3X,'CONST NQSIJ SOURCE/SINK FLOW AT I =',I5,' J =',I5,/) +C 103 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K,1) = ',E12.4, +C & 5X,'CQS(K,5) = ',E12.4) +C 203 FORMAT(5X,'K =',I5,5X,'QSS(K) = ',E12.4,5X,'CQS(K, ) = ', +C & 5X, 12E12.4) + 104 FORMAT(/) + 105 FORMAT(3X,'TIME VAR NQSIJ SOURCE/SINK FLOW AT I =',I5,' J=',I5,/) +C 106 FORMAT(5X,'K =',I5,5X,'QSERT(K) = ',E12.4, +C & 5X,'CSERT(K,1) = ',E12.4,5X,'CSERT(K,5) = ',E12.4) + 206 FORMAT(5X,'NQ,LQ =',2I4,7X,'QSERT() = ',12E12.4) + 207 FORMAT(5X,'NQ,NT,NCQ =',3I4,3X,'CSERT() = ',12E12.4) + 216 FORMAT(5X,'NQ,LQ =',2I4,3X,'QSS() = ',12E12.4) + 217 FORMAT(5X,'NQ,NT =',2I4,3X,'CQS() = ',12E12.4) + 107 FORMAT(3X,'UPSTRM CONTROLED SINK FLOW AT I =',I5,' J =',I5, + & ' L =',I5,' NQCTLT =',I5,' HUP = ',E12.4/) + 108 FORMAT(5X,'K =',I5,5X,'QCTL(K) = ',2E12.4) + 109 FORMAT(3X,'DWNSTRM CONTROLED SOURCE FLOW AT I =',I5,' J =',I5, + & ' L =',I5,' NQCTLT =',I5,' HDW = ',E12.4/) + 110 FORMAT(3X,'UPSTRM CONST WITHDRW SINK FLOW AT I =',I5,' J =',I5,/) + 111 FORMAT(5X,'K =',I5,5X,'QWR(K) = ',E12.4, + & 5X,'CQWR(1) = ',E12.4,5X,'CQWR(2) = ',E12.4) + 112 FORMAT(3X,'DWNSTRM CONST RETN SOURCE FLOW AT I =',I5,' J =',I5,/) + 113 FORMAT(3X,'UPSTRM VAR WITHDRW SINK FLOW AT I =',I5,' J =',I5,/) + 114 FORMAT(5X,'K =',I5,5X,'QSERT(K) = ',E12.4, + & 5X,'CSERT(K,1) = ',E12.4,5X,'CSERT(K,2) = ',E12.4) + 115 FORMAT(3X,'DWNSTRM VAR RETN SOURCE FLOW AT I =',I5,' J =',I5,/) + 6666 FORMAT(' SINGLE VAL CONTROL STRUCTURE TABLE OUT OF BOUNDS ') + 6667 FORMAT(' NCTL,NCTLT,IU,JU,ID,JD = ',6I5) + 6668 FORMAT(' SELU,HU,SELD,HD = ',4(2X,E12.4)) + 6676 FORMAT(' DOUBLE VAL CONTROL STRUCTURE TABLE OUT OF BOUNDS, UP ') + 6677 FORMAT(' NCTL,NCTLT,IU,JU,ID,JD = ',6I5) + 6678 FORMAT(' SELU,HU,SELD,HD = ',4(2X,E12.4)) + 6679 FORMAT(' HUF,HUL,HDF,HDL = ',4(2X,E12.4)) + 6686 FORMAT(' DOUBLE VAL CONTROL STRUCTURE TABLE OUT OF BOUNDS, DW ') + 6687 FORMAT(' NCTL,NCTLT,IU,JU,ID,JD = ',6I5) + 6688 FORMAT(' SELU,HU,SELD,HD = ',4(2X,E12.4)) + 6111 FORMAT(' INVALID NQSIJ LOCATION, NQSIJ,I,J = ',3I5) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT_mpi.for new file mode 100644 index 000000000..b685f9d1a --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSFT_mpi.for @@ -0,0 +1,354 @@ + SUBROUTINE CALSFT_mpi(ISTL_,IS2TL_) +C +C CHANGE RECORD +C ** SUBROUTINE CALSFT CALCULATES THE TRANSPORT OF SHELL FISH LARVAE +C ** AT TIME LEVEL (N+1). +C ** CALLED ONLY ON ODD THREE TIME LEVEL STEPS (PMC - NO, CALLED IN BOTH HDMT & HDMT2T) +C + USE GLOBAL + USE MPI + + ! *** DSLLC BEGIN BLOCK + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WTFKB + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WTFKC + INTEGER ISDARK + ISDARK=0 + IF(.NOT.ALLOCATED(WTFKB))THEN + ALLOCATE(WTFKB(KCM)) + ALLOCATE(WTFKC(KCM)) + ! *** ZERO LOCAL ARRAYS + WTFKB=0.0 + WTFKC=0.0 + ENDIF + ! *** DSLLC END BLOCK +C +CPMC DELT=DT2 + ! *** PMC + IF(ISTL_.EQ.2)THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + END IF + ELSE + DELT=DT2 + ENDIF + ! *** PMC +C +C ** UPDATED TIME SERIES CONCENTRATION BOUNDARY CONDITIONS +C ** DETERMINE IF CURRENT TIME STEP IS DURING DAYLIGHT OR DARKNESS +C + IF(ISSFLDN.GE.1)THEN + ISDARK=1 + IF(ISDYNSTP.EQ.0)THEN + TIME=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ELSE + TIME=TIMESEC/86400. + ENDIF + ITIME=INT(TIME) + RTIME=FLOAT(ITIME) + TIMTMP=TIME-RTIME + IF(TIMTMP.GE.TSRSF.AND.TIMTMP.LE.TSSSF) ISDARK=0 + ENDIF +C +C ** DETERMINE IF LOCAL CONDITIONS ARE EBB OR FLOOD +C + IF(ISSFLFE.GE.1)THEN + IF(KC.EQ.1)THEN + WTFKB(1)=1. + WTFKC(1)=0. + ENDIF + IF(KC.EQ.2)THEN + WTFKB(1)=1.0 + WTFKC(1)=0.0 + WTFKB(2)=0.0 + WTFKC(2)=1.0 + ENDIF + IF(KC.EQ.3)THEN + DO K=1,KC + WTFKB(K)=FLOAT(KC-K)/FLOAT(KS) + WTFKC(K)=1.0-WTFKB(K) + ENDDO + ENDIF +C +C ** SET SWITCHES TO EBB +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UUU(L,K)=0. + VVV(L,K)=1. + ENDDO + ENDDO +C +C ** RESET SWITCHES FOR FLOOD +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,FANGTMP,UTMP,VTMP, +!$OMP+ VELEKB,VELNKB,CURANG,ANGDIF) + DO L=LMPI2,LMPILA + LN=LNC(L) + FANGTMP=ACCWFLD(L,1)*WTFKB(K)+ACCWFLD(L,2)*WTFKC(K) + UTMP=0.5*STCUV(L)*(UWQ(L+1,K)+UWQ(L,K)) + VTMP=0.5*STCUV(L)*(VWQ(LN ,K)+VWQ(L,K)) + VELEKB=CUE(L)*UTMP+CVE(L)*VTMP+1.E-12 + VELNKB=CUN(L)*UTMP+CVN(L)*VTMP + CURANG=ATAN2(VELNKB,VELEKB) + ANGDIF=ABS(FANGTMP-CURANG) + IF(ANGDIF.LT.1.5708)THEN + UUU(L,K)=1. + VVV(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF +C +C ** SET UP ADVECTION FIELD +C ** SET ATTACHED TO BOTTOM AND NO ADVECTIVE TRANSPORT IN BOTTOM +C ** LAYER DURING EBB IF APPROPRIATE +C + IF(ISSFLFE.GE.1)THEN + IF(SFNTBET.LT.1.)THEN + K=1 +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + UHDYWQ(L,K)=UUU(L,1)*UHDYWQ(L,1)+SFNTBET*VVV(L,1)*UHDYWQ(L,1) + VHDXWQ(L,K)=UUU(L,1)*UHDYWQ(L,1)+SFNTBET*VVV(L,1)*VHDXWQ(L,1) + UWQ(L,K)=UUU(L,1)*UWQ(L,1)+SFNTBET*VVV(L,1)*UWQ(L,1) + VWQ(L,K)=UUU(L,1)*VWQ(L,1)+SFNTBET*VVV(L,1)*VWQ(L,1) + ENDDO + ENDIF + ENDIF + ! *** COMPUTE SHELLFISH LARVAE ADVECTION + CALL CALTRAN_mpi (ISTL_,IS2TL_,4,4,SFL,SFL2) + !CALL CALTRWQ (4,0,SFL,SFL2) ! PMC +C +C ** SET UP VERTICAL MIGRATION AND SETTLING BEHAVIOR +C ** INITIALIZE VERTICAL VELOCTIY TO TIME DEPENDENT SETTLING VELOCITY +C + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WWQ(L,K)=-WSFLSTT + ENDDO + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WWQ(L,KC)=0. + WWQ(L,0)=0. + ENDDO + IF(ISSFLFE.GE.1.AND.ISSFLDN.GE.1)THEN +C +C ** DAYLIGHT CONDITIONS +C + IF(ISDARK.EQ.0)THEN + DO K=1,KS + RABOVE=FLOAT(KC-K)/FLOAT(KC) +!$OMP PARALLEL DO PRIVATE(HABOVE) + DO L=LMPI2,LMPILA +C +C ** DETERMINE DISTANCE TO SURFACE +C + HABOVE=RABOVE*HWQ(L) + IF(UUU(L,K).GT.0.)THEN +C +C ** FLOOD CONDITION : SWIM UP TO MIN DIST BELOW SURFACE +C + IF(HABOVE.GT.DSFLMNT) WWQ(L,K)=WSFLSMT + ELSE +C +C ** EBB CONDITION : CONTINUE TO SINK OR SWIM UP TO MAX DIST BL SURF +C + IF(HABOVE.GT.DSFLMXT) WWQ(L,K)=WSFLSMT + ENDIF + ENDDO + ENDDO + ENDIF +C +C ** DARK CONDITIONS +C + IF(ISDARK.EQ.1)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA +C +C ** FLOOD CONDITION : SWIM UP TO SURFACE +C + WWQ(L,K)=VVV(L,K)*WWQ(L,K)+UUU(L,K)*WSFLSMT + ENDDO + ENDDO + ENDIF + ENDIF + IF(SFATBTT.GT.0.)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WWQ(L,0)=-WSFLSTT + ENDDO + ENDIF +C +C ** CALCULATE NET VERTICAL SWIMING OR SETTLING +C + IF(WSFLSMT.EQ.0.) GOTO 100 +C +C ** LIMIT VERTICAL SETTLING AND/OR SWIMMING FOR STABILITY +C + DO K=0,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WWW(L,K)=MIN(WWQ(L,K),0.) + WWW(L,K)=ABS(WWW(L,K)) + WWQ(L,K)=MAX(WWQ(L,K),0.) + ENDDO + ENDDO + TMPVAL=0.25/(DELT*FLOAT(KC)) + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(WMAXX) + DO L=LMPI2,LMPILA + WMAXX=TMPVAL*HWQ(L) + WWW(L,K)=MIN(WWW(L,K),WMAXX) + WWQ(L,K)=MIN(WWQ(L,K),WMAXX) + WWQ(L,K)=WWQ(L,K)-WWW(L,K) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,K)=MAX(WWQ(L,K),0.)*SFL(L,K) + & +MIN(WWQ(L,K),0.)*SFL(L,K+1) + ENDDO + ENDDO + IF(SFATBTT.GT.0.)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SFLSBOT(L)=SFLSBOT(L)-DELT*FWU(L,0) + ENDDO + ENDIF + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SFL(L,K)=SFL(L,K) + & +DELT*(FWU(L,K-1)-FWU(L,K))*DZIC(K)/HWQ(L) + ENDDO + ENDDO + GOTO 200 + 100 CONTINUE +C +C ** FULLY IMPLICIT SETTLING IF SWIMMING IS ZERO EVERYWHERE +C ** FULLY IMPLICIT SETTLING IN SURFACE LAYER +C + TMPVAL=DELT*WSFLSTT + DZCIT=TMPVAL/DZC(KC) +!$OMP PARALLEL DO PRIVATE(TMPVAL1) + DO L=LMPI2,LMPILA + TMPVAL1=DZCIT/HWQ(L) + SFL(L,KC)=SFL(L,KC)/(1.+TMPVAL1) + ENDDO +C +C ** FULLY IMPLICIT SETTLING IN REMAINING LAYERS +C + IF(KC.GT.1)THEN + DO K=KS,1,-1 + DZCIT=TMPVAL/DZC(K) +!$OMP PARALLEL DO PRIVATE(TMPVAL1) + DO L=LMPI2,LMPILA + TMPVAL1=DZCIT/HWQ(L) + SFL(L,K)=(SFL(L,K)+TMPVAL1*SFL(L,K+1))/(1.+TMPVAL1) + ENDDO + ENDDO + ENDIF + IF(SFATBTT.GT.0.)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SFLSBOT(L)=SFLSBOT(L)+TMPVAL*SFL(L,1) + ENDDO + ENDIF + 200 CONTINUE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,0)=0. + WWQ(L,0)=0. + WWW(L,0)=0. + ENDDO +C +C ** CALCULATE LINEAR DECAY +C + IF(RKDSFLT.GE.0.)THEN + CDYETMP=1./(1.+DELT*RKDSFLT) + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SFL(L,K)=CDYETMP*SFL(L,K) + ENDDO + ENDDO + ENDIF + IF(KC.EQ.1) GOTO 2000 +C +C ** VERTICAL DIFFUSION CALCULATION +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HWQI(L)=1./HWQ(L) + ENDDO + RCDZKK=-DELT*CDZKK(1) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + SFL(L,1)=SFL(L,1)*EEB + ENDDO + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + SFL(L,K)=(SFL(L,K)-CCLBTMP*SFL(L,K-1))*EEB + ENDDO + ENDDO + ENDDO + K=KC + RCDZKMK=-DELT*CDZKMK(K) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + SFL(L,K)=(SFL(L,K)-CCLBTMP*SFL(L,K-1))*EEB + ENDDO + ENDDO + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO K=KC-1,1,-1 + DO L=LF,LL + SFL(L,K)=SFL(L,K)-CU1(L,K)*SFL(L,K+1) + ENDDO + ENDDO + ENDDO +C +C ** UPDATE SHELL FISH LARVAE CONCENTRATIONS +C + 2000 CONTINUE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + SFL2(L,K)=SFL(L,K) + ENDDO + ENDDO + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY_mpi.for new file mode 100644 index 000000000..cafa16b1f --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTBXY_mpi.for @@ -0,0 +1,795 @@ + SUBROUTINE CALTBXY_mpi(ISTL_,IS2TL_) +C +C ** SUBROUTINE CALTBXY CALCULATES BOTTOM FRICTION OR DRAG +C ** COEFFICIENTS IN QUADRATIC LAW FORM REFERENCED TO NEAR +C ** BOTTOM OR DEPTH AVERAGED HORIZONTAL VELOCITIES +C ** FOR VEGETATION RESISTANCE IN DEPTH INTEGRATED FLOW +C ** THE COEFFICIENT REPRESENTS BOTTOM AND WATER COLUMN VEGETATION +C ** RESISTANCE +C CHANGE RECORD +C REMOVED DRAG COEFFICIENT CONSTRAINT FOR MULIPLE LAYER ROUGHT +C BOUNDARIES WHEN DYNAMIC TIME STEPPING IS ACTIVE +C FIXED POSSIBLE DIVIDE BY ZERO FOR SUB GRID CHANNEL FRICTION IN +C ABSENCE OF VEGETATION RESISTANCE +C ADDED DRY CELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES +C + USE GLOBAL + USE MPI + + IMPLICIT NONE + INTEGER::ISTL_,IS2TL_,L,K,LS,M,LW,LE,LN,LNW,LSE,MW,MS + INTEGER::NMD,LHOST,LCHNU,LCHNV,MH,MU,MV,NTMP + INTEGER::LZBMIN,LCDMAX,LCDMIN,LZBMAX,JWCBLV,JWCBLU + REAL::CDLIMIT,CDTOTUM,CDTOTVM,CDMAXUM,CDMAXVM + REAL::ZBRATU,ZBRATV,UMAGTMP,VMAGTMP,CDMAXU,CDMAXV + REAL::HURTMP,HVRTMP,HUDZBR,HVDZBR,VTMPATU,UTMPATV,CPVEGU,RVEGUM + REAL::CPVEGV,RVEGVM,HVGTC,HVGTW,HVGTS,VISEXP,VISFAC,VISMUDU + REAL::VISMUDV,SEDTMP,CSEDVIS,VISDHU,VISDHV,DZHUDZBR,DZHVDZBR + REAL::FRACLAY,FHLAYC,FHLAYW,FHLAYS,WCHAN,RLCHN,HCHAN,STBXCH + REAL::FXVEGCH,STBYCH,FYVEGCH,TMPVALW,WVFACT,QQWCTMP,TWCTMP + REAL::AEXTMP,TMPVAL,USTARC,CDRGTMP,TAUBTMP,TAUE,RIPAMP + REAL::RIPSTP,RIPFAC,ZBRMAX,ZBRMIN,CDRGMAX,ZBREU + REAL::CDRGMIN,WVDTMP,RKZTURB,UTMP,VTMP,DWVDZ,DWUDZ,DWVD2Z + REAL::DWUD2Z,HZRVDZ,HZRUDZ,ZDHZRV,ZDHZRU,ZBREV,HZREFV,HZREFU + REAL::QWDQCV,QWDQCU,QCTMPV,QCTMPU,HOTLYMN,HOTLYMX,CDTMPVY + REAL::BOTTMP,DWVDHR,DWUDHR,QWCTMPV,QWCTMPU + REAL::CDTMPV,CDTMPU,COSWC,CURANG,CDTMPUX + REAL::WVDELV,WVDELU,TAUTMP + LCDMIN=0 + LCDMAX=0 + LZBMIN=0 + LZBMAX=0 + WVDTMP=0.0 + + DELT=DT2 + ISUD=1 + IF(ISTL_.NE.3)THEN + DELT=DT + ISUD=0 + ENDIF + IF(IS2TL_.EQ.1)THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + END IF + ISUD=1 + ENDIF + DELTI=1./DELT +C +C ** IF WAVE-CURRENT BBL MODEL IS ACTIVE, GOTO WAVE CURRENT BBL +C + IF(ISWCBL.GE.1) GOTO 1947 +C +C ** INITIALIZE IMPLICIT BOTTOM FRICTION AND SET DIAGNOSTIC FILES +C ** ON FIRST CALL +C + IF(JSTBXY.EQ.1) GOTO 100 + IF(ISITB.GE.1)THEN + IF(ISITB.EQ.1)THEN + RITB1=0.45 + RITB=0.55 + CDLIMIT=1. + ELSE + RITB1=0.0 + RITB=1.0 + CDLIMIT=10. + ENDIF + ELSE + RITB1=1.0 + RITB=0.0 + CDLIMIT=0.5 + ENDIF + IF(ISVEG.GE.2.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CBOT.LOG',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + STBXO(L)=STBX(L) + STBYO(L)=STBY(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + STBX(L)=0. + STBY(L)=0. + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FXVEG(L,K)=0. + FYVEG(L,K)=0. + ENDDO + ENDDO + MPI_WTIMES(851)=MPI_WTIMES(851)+MPI_TOC(S1TIME) + N=-2 + JSTBXY=1 + 100 CONTINUE + IF(ISITB.GE.1)THEN + IF(ISITB.EQ.1)THEN + CDLIMIT=10. + ELSE + CDLIMIT=100. + ENDIF + ELSE + CDLIMIT=0.5 + ENDIF +C +C ** INITIALIZED DIAGNOSTICS FOR STANDARD AND VEGE +C ** RESISTANCE CALCULATION +C + IF(ISVEG.GE.2.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CBOT.LOG',POSITION='APPEND',STATUS='UNKNOWN') + ENDIF + CDTOTUM=0. + CDTOTVM=0. + CDMAXUM=0. + CDMAXVM=0. + IF(ISVEG.EQ.0) UVEGSCL=1.E-12 + IF(KC.GT.1) GOTO 200 +C +C ** NORMAL ENTRY INTO STANDARD AND VEGE RESISTANCE CALCULATION +C ** FOR SINGLE LAYER +C ** VEGETATION DRAG +C CALCULATE R FOR LAMINAR FLOW +C CALCULATE R FOR LAMINAR FLOW +C ** END VEGETATION DRAG +C ** NORMAL ENTRY INTO STANDARD AND VEGE RESISTANCE CALCULATION +C ** FOR SINGLE LAYER +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS,ZBRATU,ZBRATV,UMAGTMP,VMAGTMP,CDMAXU, +!$OMP+ CDMAXV,HURTMP,HVRTMP,HUDZBR,HVDZBR) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + ZBRATU=0.5*(DXP(L-1)*ZBR(L-1)+DXP(L)*ZBR(L))*DXIU(L) + ZBRATV=0.5*(DYP(LS )*ZBR(LS )+DYP(L)*ZBR(L))*DYIV(L) + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + HURTMP=MAX(ZBRATU,H1U(L)) + HVRTMP=MAX(ZBRATV,H1V(L)) + HUDZBR=HURTMP/ZBRATU + IF(HUDZBR.LT.7.5) HUDZBR=7.5 + HVDZBR=HVRTMP/ZBRATV + IF(HVDZBR.LT.7.5) HVDZBR=7.5 + STBX(L)=STBXO(L)*.16/( (LOG( HUDZBR ) -1.)**2) + STBY(L)=STBYO(L)*.16/( (LOG( HVDZBR ) -1.)**2) + STBX(L)=MIN(CDMAXU,STBX(L)) + STBY(L)=MIN(CDMAXV,STBY(L)) + ENDIF + ENDDO + MPI_WTIMES(852)=MPI_WTIMES(852)+MPI_TOC(S1TIME) + IF(ISVEG.GE.1)THEN + K=1 + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(M,LW,LE,LS,LN,LNW,LSE,MW,MS, +!$OMP+ VTMPATU,UTMPATV,UMAGTMP,VMAGTMP,CDMAXU, +!$OMP+ CDMAXV,RVEGUM,CPVEGU,RVEGVM,CPVEGV,HVGTC,HVGTW, +!$OMP+ HVGTS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + M=MVEGL(L) + FXVEG(L,K)=0. + FYVEG(L,K)=0. +C *** DSLLC BEGIN BLOCK + IF(M.NE.MVEGOW.AND.M.NE.0)THEN + LW=L-1 + LE=L+1 + LS=LSC(L) + LN=LNC(L) + LNW=LNWC(L) + LSE=LSEC(L) + MW=MVEGL(LW) + MS=MVEGL(LS) + VTMPATU=0.25*(V(L,K)+V(LW,K)+V(LN,K)+V(LNW,K)) + UTMPATV=0.25*(U(L,K)+U(LE,K)+U(LS,K)+U(LSE,K)) + UMAGTMP=SQRT( U(L,K)*U(L,K)+VTMPATU*VTMPATU +1.E-12 ) + VMAGTMP=SQRT( UTMPATV*UTMPATV+V(L,K)*V(L,K) +1.E-12 ) + UMAGTMP=MAX(UMAGTMP,UVEGSCL) + VMAGTMP=MAX(VMAGTMP,UVEGSCL) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + IF(N.EQ.-2)THEN + VTMPATU=0.25*(V1(L,K)+V1(LW,K)+V1(LN,K)+V1(LNW,K)) + UTMPATV=0.25*(U1(L,K)+U1(LE,K)+U1(LS,K)+U1(LSE,K)) + UMAGTMP=SQRT( U1(L,K)*U1(L,K)+VTMPATU*VTMPATU+1.E-12 ) + VMAGTMP=SQRT( UTMPATV*UTMPATV+V1(L,K)*V1(L,K)+1.E-12 ) + ENDIF + CPVEGU=1.0 + IF(ISVEGL.EQ.1) CPVEGU=CPVEGU + 10.E-6/( + & (BPVEG(MW)+BPVEG(M))*UMAGTMP ) + IF(CPVEGU.GT.1.0)THEN +C CALCULATE R FOR LAMINAR FLOW + CPVEGU=CPVEGU-0.5 + RVEGUM=0. + ENDIF + CPVEGU=SCVEG(M)*CPVEGU + CPVEGV=1.0 + IF(ISVEGL.EQ.1) CPVEGV=CPVEGV + 10.E-6/( + & (BPVEG(MS)+BPVEG(M))*VMAGTMP ) + IF(CPVEGV.GT.1.0)THEN +C CALCULATE R FOR LAMINAR FLOW + CPVEGV=CPVEGV-0.5 + RVEGVM=0. + ENDIF + CPVEGV=SCVEG(M)*CPVEGV + HVGTC=MIN(HPVEG(M),HP(L)) + HVGTW=MIN(HPVEG(MW),HP(L-1)) + HVGTS=MIN(HPVEG(MS),HP(LS)) + FXVEG(L,K)=0.25*CPVEGU*( DXP(L)*(BDLPSQ(M)*HVGTC/PVEGZ(M)) + & +DXP(L-1)*(BDLPSQ(MW)*HVGTW/PVEGZ(MW)) )*DXIU(L) + FYVEG(L,K)=0.25*CPVEGV*( DYP(L)*(BDLPSQ(M)*HVGTC/PVEGZ(M)) + & +DYP(LS)*(BDLPSQ(MS)*HVGTS/PVEGZ(MS)) )*DYIV(L) + FXVEG(L,K)=MIN(FXVEG(L,K),CDMAXU) + FYVEG(L,K)=MIN(FYVEG(L,K),CDMAXU) + ENDIF +C +C *** DSLLC END BLOCK +C + ENDIF + ENDDO + MPI_WTIMES(853)=MPI_WTIMES(853)+MPI_TOC(S1TIME) + ENDIF + GOTO 300 +C +C ** NORMAL ENTRY INTO STANDARD AND VEGE RESISTANCE CALCULATION +C ** FOR MULTIPLE LAYER +C + 200 CONTINUE +C +C ** BEGIN SMOOTH DRAG FORMULATION +C + VISEXP=2./7. + VISFAC=0.0258*(COEFTSBL**VISEXP) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(UMAGTMP,VMAGTMP,CDMAXU,CDMAXV, +!$OMP+ VISMUDU,VISMUDV,SEDTMP,VISDHU,VISDHV) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + IF(ZBR(L).LE.1.E-6)THEN + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + VISMUDU=VISMUD + VISMUDV=VISMUD + IF(ISMUD.GE.1)THEN + SEDTMP=0.5*(SED(L,1,1)+SED(L-1,1,1)) + VISMUDU=CSEDVIS(SEDTMP) + SEDTMP=0.5*(SED(L,1,1)+SED(LSC(L),1,1)) + VISMUDV=CSEDVIS(SEDTMP) + ENDIF +C ** DELETED COMMENTED OUT LINES & UNUSED VARIABLES + VISDHU=0.0 + VISDHV=0.0 + IF(UMAGTMP.GT.0.0) VISDHU=(VISMUDU*HUI(L)/UMAGTMP)*VISEXP + IF(VMAGTMP.GT.0.0) VISDHV=(VISMUDV*HVI(L)/VMAGTMP)*VISEXP + STBX(L)=VISFAC*AVCON*STBXO(L)*VISDHU + STBY(L)=VISFAC*AVCON*STBYO(L)*VISDHV + STBX(L)=MIN(CDMAXU,STBX(L)) + STBY(L)=MIN(CDMAXV,STBY(L)) + ENDIF + ENDIF + ENDDO + MPI_WTIMES(854)=MPI_WTIMES(854)+MPI_TOC(S1TIME) +C +C ** END SMOOTH DRAG FORMULATION +C +C ** BEGIN ROUGH DRAG FORMULATION +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS,ZBRATU,ZBRATV,UMAGTMP,VMAGTMP, +!$OMP+ CDMAXU,CDMAXV,HURTMP,HVRTMP,DZHUDZBR,DZHVDZBR) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + IF(ZBR(L).GT.1.E-6)THEN + ZBRATU=0.5*(DXP(L-1)*ZBR(L-1)+DXP(L)*ZBR(L))*DXIU(L) + ZBRATV=0.5*(DYP(LS )*ZBR(LS )+DYP(L)*ZBR(L))*DYIV(L) + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + HURTMP=MAX(ZBRATU,H1U(L)) + HVRTMP=MAX(ZBRATV,H1V(L)) + DZHUDZBR=1.+0.5*DZC(1)*HURTMP/ZBRATU + DZHVDZBR=1.+0.5*DZC(1)*HVRTMP/ZBRATV + STBX(L)=AVCON*STBXO(L)*.16/((LOG(DZHUDZBR))**2) + STBY(L)=AVCON*STBYO(L)*.16/((LOG(DZHVDZBR))**2) + STBX(L)=MIN(CDMAXU,STBX(L)) + STBY(L)=MIN(CDMAXV,STBY(L)) + ENDIF + ENDIF + ENDDO + MPI_WTIMES(855)=MPI_WTIMES(855)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS,ZBRATU,ZBRATV,UMAGTMP,VMAGTMP, +!$OMP+ CDMAXU,CDMAXV,HURTMP,HVRTMP,DZHUDZBR,DZHVDZBR) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L).AND.ZBR(L).GT.1.E-6)THEN + LS=LSC(L) + ZBRATU=0.5*(DXP(L-1)*ZBR(L-1)+DXP(L)*ZBR(L))*DXIU(L) + ZBRATV=0.5*(DYP(LS )*ZBR(LS )+DYP(L)*ZBR(L))*DYIV(L) + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + HURTMP=MAX(ZBRATU,H1U(L)) + HVRTMP=MAX(ZBRATV,H1V(L)) + DZHUDZBR=1.+0.5*DZC(1)*HURTMP/ZBRATU + DZHVDZBR=1.+0.5*DZC(1)*HVRTMP/ZBRATV + STBX(L)=AVCON*STBXO(L)*.16/((LOG(DZHUDZBR))**2) + STBY(L)=AVCON*STBYO(L)*.16/((LOG(DZHVDZBR))**2) + STBX(L)=MIN(CDMAXU,STBX(L)) + STBY(L)=MIN(CDMAXV,STBY(L)) + ENDIF + ENDDO + MPI_WTIMES(855)=MPI_WTIMES(855)+MPI_TOC(S1TIME) +C +C ** END ROUGH DRAG FORMULATION +C + S1TIME=MPI_TIC() + IF(N.EQ.-2)THEN +!$OMP PARALLEL DO PRIVATE(LS,ZBRATU,ZBRATV,UMAGTMP,VMAGTMP, +!$OMP+ CDMAXU,CDMAXV,HURTMP,HVRTMP,DZHUDZBR,DZHVDZBR) + DO L=LMPI2,LMPILA + LS=LSC(L) + ZBRATU=0.5*(DXP(L-1)*ZBR(L-1)+DXP(L)*ZBR(L))*DXIU(L) + ZBRATV=0.5*(DYP(LS )*ZBR(LS )+DYP(L)*ZBR(L))*DYIV(L) + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + HURTMP=MAX(ZBRATU,H1U(L)) + HVRTMP=MAX(ZBRATV,H1V(L)) + DZHUDZBR=1.+0.5*DZC(1)*HURTMP/ZBRATU + DZHVDZBR=1.+0.5*DZC(1)*HVRTMP/ZBRATV + STBX(L)=AVCON*STBXO(L)*.16/((LOG(DZHUDZBR))**2) + STBY(L)=AVCON*STBYO(L)*.16/((LOG(DZHVDZBR))**2) + STBX(L)=MIN(CDMAXU,STBX(L)) + STBY(L)=MIN(CDMAXV,STBY(L)) + ENDDO + ENDIF + MPI_WTIMES(856)=MPI_WTIMES(856)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(ISVEG.GE.1)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(M,LW,LE,LS,LN,LNW,LSE,MW,MS, +!$OMP+ VTMPATU,UTMPATV,UMAGTMP,VMAGTMP,CDMAXU,CDMAXV, +!$OMP+ CPVEGU,CPVEGV,RVEGUM,RVEGVM,FRACLAY,FHLAYC, +!$OMP+ FHLAYW,FHLAYS,HVGTC,HVGTW,HVGTS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + M=MVEGL(L) + FXVEG(L,K)=0. + FYVEG(L,K)=0. + IF(M.NE.MVEGOW.AND.M.NE.0)THEN + LW=L-1 + LE=L+1 + LS=LSC(L) + LN=LNC(L) + LNW=LNWC(L) + LSE=LSEC(L) + MW=MVEGL(LW) + MS=MVEGL(LS) + VTMPATU=0.25*(V(L,K)+V(LW,K)+V(LN,K)+V(LNW,K)) + UTMPATV=0.25*(U(L,K)+U(LE,K)+U(LS,K)+U(LSE,K)) + UMAGTMP=SQRT( U(L,K)*U(L,K)+VTMPATU*VTMPATU +1.E-12 ) + VMAGTMP=SQRT( UTMPATV*UTMPATV+V(L,K)*V(L,K) +1.E-12 ) + UMAGTMP=MAX(UMAGTMP,UVEGSCL) + VMAGTMP=MAX(VMAGTMP,UVEGSCL) + CDMAXU=CDLIMIT*STBXO(L)*H1U(L)/( DELT*UMAGTMP ) + CDMAXV=CDLIMIT*STBYO(L)*H1V(L)/( DELT*VMAGTMP ) + IF(N.EQ.-2)THEN + VTMPATU=0.25*(V1(L,K)+V1(LW,K)+V1(LN,K)+V1(LNW,K)) + UTMPATV=0.25*(U1(L,K)+U1(LE,K)+U1(LS,K)+U1(LSE,K)) + UMAGTMP=SQRT( U1(L,K)*U1(L,K)+VTMPATU*VTMPATU+1.E-12 ) + VMAGTMP=SQRT( UTMPATV*UTMPATV+V1(L,K)*V1(L,K)+1.E-12 ) + ENDIF + CPVEGU=1.0 + IF(ISVEGL.EQ.1) CPVEGU=CPVEGU + 10.E-6/( + & (BPVEG(MW)+BPVEG(M))*UMAGTMP ) + IF(CPVEGU.GT.1.0)THEN +C CALCULATE R FOR LAMINAR FLOW + CPVEGU=CPVEGU-0.5 + RVEGUM=0. + ENDIF + CPVEGU=SCVEG(M)*CPVEGU + CPVEGV=1.0 + IF(ISVEGL.EQ.1) CPVEGV=CPVEGV + 10.E-6/( + & (BPVEG(MS)+BPVEG(M))*VMAGTMP ) + IF(CPVEGV.GT.1.0)THEN +C CALCULATE R FOR LAMINAR FLOW + CPVEGV=CPVEGV-0.5 + RVEGVM=0. + ENDIF + CPVEGV=SCVEG(M)*CPVEGV + FRACLAY=FLOAT(K)/FLOAT(KC) + FHLAYC=FRACLAY*HP(L) + FHLAYW=FRACLAY*HP(L-1) + FHLAYS=FRACLAY*HP(LS) + HVGTC=HP(L) + HVGTW=HP(L-1) + HVGTS=HP(LS) + IF(HPVEG(M).LT.FHLAYC) HVGTC=0.0 + IF(HPVEG(MW).LT.FHLAYW) HVGTW=0.0 + IF(HPVEG(MS).LT.FHLAYS) HVGTS=0.0 + FXVEG(L,K)=0.25*CPVEGU*(DXP(L)*(BDLPSQ(M)*HVGTC/PVEGZ(M)) + & +DXP(L-1)*(BDLPSQ(MW)*HVGTW/PVEGZ(MW)) )*DXIU(L) + FYVEG(L,K)=0.25*CPVEGV*(DYP(L)*(BDLPSQ(M)*HVGTC/PVEGZ(M)) + & +DYP(LS)*(BDLPSQ(MS)*HVGTS/PVEGZ(MS)) )*DYIV(L) + FXVEG(L,K)=MIN(FXVEG(L,K),CDMAXU) + FYVEG(L,K)=MIN(FYVEG(L,K),CDMAXU) + ENDIF +C +C *** DSLLC END BLOCK +C + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(857)=MPI_WTIMES(857)+MPI_TOC(S1TIME) + 300 CONTINUE +C +C ** SUBGRID SCALE CHANNEL FRICTION +C + S1TIME=MPI_TIC() + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + LHOST=LMDCHH(NMD) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) + MH=MVEGL(LHOST) +C X-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.1)THEN + MU=0 + IF(ISVEG.GE.1) MU=MVEGL(LCHNU) + WCHAN=DXP(LCHNU) + RLCHN=0.5*DYP(LCHNU)+CHANLEN(NMD) + HCHAN=0.5*DYP(LCHNU)*H1P(LCHNU)+CHANLEN(NMD)*H1P(LHOST) + HCHAN=HCHAN/RLCHN + ZBRATU=0.5*DYP(LCHNU)*ZBR(LCHNU)+CHANLEN(NMD)*ZBR(LHOST) + ZBRATU=ZBRATU/RLCHN + HURTMP=MAX(ZBRATU,HCHAN) + HUDZBR=HURTMP/ZBRATU + IF(HUDZBR.LT.7.5) HUDZBR=7.5 + STBXCH=0.16/( (LOG( HUDZBR ) -1.)**2) + CDMAXU=HCHAN*HCHAN*WCHAN/( DELT*(QCHANU(NMD)+1.E-12) ) + STBXCH=MAX(STBXCH,CDMAXU) + STBXCH=MAX(STBXCH,0.1) + FXVEGCH=0.0 + IF(MU.GT.0) FXVEGCH= + & 0.5*(0.5*DYP(LCHNU)*(BDLPSQ(MU)*H1P(LCHNU)/PVEGZ(MU)) + & +CHANLEN(NMD)*(BDLPSQ(MH)*H1P(LHOST)/PVEGZ(MH)) )/RLCHN + CHANFRIC(NMD)=FXVEGCH+STBXCH + ENDIF +C Y-DIRECTION CHANNEL + IF(MDCHTYP(NMD).EQ.2)THEN + MV=0 + IF(ISVEG.GE.1) MV=MVEGL(LCHNV) + WCHAN=DYP(LCHNV) + RLCHN=0.5*DXP(LCHNV)+CHANLEN(NMD) + HCHAN=0.5*DXP(LCHNV)*H1P(LCHNV)+CHANLEN(NMD)*H1P(LHOST) + HCHAN=HCHAN/RLCHN + ZBRATV=0.5*DXP(LCHNV)*ZBR(LCHNV)+CHANLEN(NMD)*ZBR(LHOST) + ZBRATV=ZBRATV/RLCHN + HVRTMP=MAX(ZBRATV,HCHAN) + HVDZBR=HVRTMP/ZBRATV + IF(HVDZBR.LT.7.5) HVDZBR=7.5 + STBYCH=0.16/( (LOG( HVDZBR ) -1.)**2) + CDMAXV=HCHAN*HCHAN*WCHAN/( DELT*(QCHANV(NMD)+1.E-12) ) + STBYCH=MAX(STBYCH,CDMAXV) + STBYCH=MAX(STBYCH,0.1) + FYVEGCH=0.0 + IF(MV.GT.0) FYVEGCH= + & 0.5*(0.5*DXP(LCHNV)*(BDLPSQ(MV)*H1P(LCHNV)/PVEGZ(MV)) + & +CHANLEN(NMD)*(BDLPSQ(MH)*H1P(LHOST)/PVEGZ(MH)) )/RLCHN + CHANFRIC(NMD)=FYVEGCH+STBYCH + ENDIF + ENDDO + ENDIF + MPI_WTIMES(858)=MPI_WTIMES(858)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISVEG.GE.2.AND.KC.GT.1.AND.MYRANK.EQ.0)THEN + DO L=2,LA + M=MVEGL(L) + MW=MVEGL(L-1) + MS=MVEGL(LSC(L)) + WRITE(1,1122)N,IL(L),JL(L),MVEGL(L),PVEGZ(M),PVEGZ(MS), + & PVEGZ(MW),STBX(L),STBY(L) + WRITE(1,1123)(FXVEG(L,K),K=1,KC) + WRITE(1,1123)(FYVEG(L,K),K=1,KC) + ENDDO + ENDIF + MPI_WTIMES(859)=MPI_WTIMES(859)+MPI_TOC(S1TIME) + IF(ISVEG.GE.2.AND.MYRANK.EQ.0) CLOSE(1) + 1122 FORMAT(4I5,5E12.4) + 1123 FORMAT(15X,10E12.4) + GOTO 1948 +C +C ** ENTER HERE FOR WAVE-CURRENT BOUNDARY LAYER +C + 1947 CONTINUE + S1TIME=MPI_TIC() + IF(JSTBXY.EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + STBXO(L)=STBX(L) + STBYO(L)=STBY(L) + ENDDO + N=0 + JSTBXY=1 + IF(ISDZBR.GE.1.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='ZBREMX.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + ENDIF + IF(ISDZBR.EQ.N.AND.DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='CDDIAG.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CDDIAG.OUT',STATUS='UNKNOWN') + ENDIF + NTMP=MAX(N,1) + IF(NTMP.LT.NTSWV)THEN + TMPVALW=FLOAT(NTMP)/FLOAT(NTSWV) + WVFACT=0.5-0.5*COS(PI*TMPVALW) + ELSE + WVFACT=1.0 + ENDIF + MPI_WTIMES(860)=MPI_WTIMES(860)+MPI_TOC(S1TIME) +C +C *** DSLLC BEGIN BLOCK +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(QQWCTMP,TWCTMP,AEXTMP,TMPVAL,USTARC, +!$OMP+ CDRGTMP,TAUTMP,TAUBTMP,TAUE,RIPAMP,RIPSTP,RIPFAC) + DO L=LMPI2,LMPILA + IF(UWVSQ(L).GT.1.E-6 .AND. LMASKDRY(L))THEN + QQWCTMP=SQRT( QQWV2(L)*QQWV2(L)+QQ(L,0)*QQ(L,0) ) + TWCTMP=QQWCTMP/CTURB2 + AEXTMP=WVWHA(L)/SINH(WVKHP(L)) + ZBRE(L)=ZBR(L) + IF(QQ(L,0).GT.0.)THEN + TMPVAL=UWVSQ(L)*SQRT( AEXTMP/(30.*ZBR(L)) ) + USTARC=SQRT(QQ(L,0)/CTURB2) + TMPVAL=TMPVAL/USTARC + ZBRE(L)=ZBR(L)*(1.+0.19*TMPVAL) + ENDIF + CDRGTMP=(30.*ZBRE(L)/AEXTMP)**0.2 + CDRGTMP=5.57*CDRGTMP-6.13 + CDRGTMP=EXP(CDRGTMP) + CDRGTMP=MIN(CDRGTMP,0.22) + TAUTMP=0.5*CDRGTMP*UWVSQ(L) + QQWV2(L)=CTURB2*TAUTMP*WVFACT + QQWC(L)=SQRT( QQWV2(L)*QQWV2(L)+QQ(L,0)*QQ(L,0) ) + IF(ISTRAN(7).GT.0)THEN + TWCTMP=QQWC(L)/CTURB2 + TAUBTMP=QQWV1(L)/CTURB2 + TAUE=TWCTMP/TAUN(NSED+1) + RIPAMP=0. + RIPSTP=0. + IF(TAUBTMP.GT.TAUN(NSED+1).AND.TAUBTMP.LE.TAUD(NSED+1))THEN + RIPAMP=0.22/(TAUE**0.16) + RIPSTP=0.16/(TAUE**0.04) + ENDIF + IF(TAUBTMP.GT.TAUD(NSED+1))THEN + RIPAMP=0.78/(TAUE**1.5) + RIPSTP=0.41/TAUE + ENDIF + RIPAMP=RIPAMP*WVWHA(L)/SINH(WVKHP(L)) + TMPVAL=0. + IF(RIPAMP.GT.0.) TMPVAL=LOG(RIPAMP/ZBRE(L))-1. + TMPVAL=MAX(TMPVAL,0.) + RIPFAC=1.+3.125*TMPVAL*TMPVAL*RIPSTP + QQWV3(L)=RIPFAC*QQWV2(L) + QQWCR(L)=SQRT( QQWV3(L)*QQWV3(L)+QQ(L,0)*QQ(L,0) ) + ELSE + QQWCR(L)=QQ(L,0) + ENDIF + ELSE + QQWV2(L)=QQLMIN + QQWC(L)=QQ(L,0) + QQWCR(L)=QQ(L,0) + ENDIF + ENDDO + MPI_WTIMES(861)=MPI_WTIMES(861)+MPI_TOC(S1TIME) +C +C *** DSLLC END BLOCK +C + ZBRMAX=-(1.E+12)*ZBRADJ + ZBRMIN=(1.E+12)*ZBRADJ + CDRGMAX=-1.E+12 + CDRGMIN=1.E+12 + IF(ISWAVE.EQ.1.OR.ISWAVE.EQ.2)WVDTMP=0.4/(WVFRQ*CTURB3) + RKZTURB=0.4/CTURB3 + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(LS,LN,UTMP,VTMP,CURANG,COSWC,UMAGTMP,VMAGTMP, +!$OMP+ CDMAXU,CDMAXV,CDTMPU,CDTMPV,QWCTMPU,QWCTMPV,WVDELU, +!$OMP+ WVDELV,QCTMPU,QCTMPV,QWDQCU,QWDQCV,HZREFU,HZREFV,ZBREU,ZBREV, +!$OMP+ ZDHZRU,ZDHZRV,HZRUDZ,HZRVDZ,DWUD2Z,DWVD2Z,DWUDZ,DWVDZ,DWUDHR, +!$OMP+ DWVDHR,CDTMPUX,CDTMPVY,JWCBLU,JWCBLV,BOTTMP) +!$OMP+ FIRSTPRIVATE(WVDTMP) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + LN=LNC(L) + UTMP=0.5*STCUV(L)*(U(L+1,1)+U(L,1))+1.E-12 + VTMP=0.5*STCUV(L)*(V(LN,1)+V(L,1)) + CURANG=ATAN2(VTMP,UTMP) + COSWC=COS(CURANG-WACCWE(L)) + UMAGTMP=SQRT( U1(L,1)*U1(L,1)+V1U(L)*V1U(L)+1.E-12 ) + VMAGTMP=SQRT( U1V(L)*U1V(L)+V1(L,1)*V1(L,1)+1.E-12 ) + CDMAXU=STBXO(L)*H1U(L)/( 4.*DELT*UMAGTMP ) + CDMAXV=STBYO(L)*H1V(L)/( 4.*DELT*VMAGTMP ) + CDTMPU=-1. + CDTMPV=-1. + QWCTMPU=0.5*( QQWV2(L)+QQWV2(L+1) ) + QWCTMPV=0.5*( QQWV2(L)+QQWV2(LS ) ) + IF(ISWCBL.EQ.2)THEN + QWCTMPU=0.5*( QQWC(L)+QQWC(L+1) ) + QWCTMPV=0.5*( QQWC(L)+QQWC(LS ) ) + ENDIF + IF(ISWAVE.EQ.3)THEN + IF(WVFRQL(L).GT.1E-6)THEN + WVDTMP=0.4/(WVFRQL(L)*CTURB3) + ELSE + WVDTMP=0. + ENDIF + ENDIF + WVDELU=WVDTMP*SQRT(QWCTMPU) + WVDELV=WVDTMP*SQRT(QWCTMPV) + QWCTMPU=0.5*( QQWCR(L)+QQWCR(L+1) ) + QWCTMPV=0.5*( QQWCR(L)+QQWCR(LS ) ) + QWCTMPU=SQRT(QWCTMPU) + QWCTMPV=SQRT(QWCTMPV) + QCTMPU=0.5*( QQ(L,0)+QQ(L+1,0) ) + QCTMPV=0.5*( QQ(L,0)+QQ(LS ,0) ) + QWDQCU=QWCTMPU/SQRT(QCTMPU) + QWDQCV=QWCTMPV/SQRT(QCTMPV) + HZREFU=DZC(1)*H1U(L) + HZREFV=DZC(1)*H1V(L) + ZBREU=0.5*(ZBRE(L)+ZBRE(L+1)) + ZBREV=0.5*(ZBRE(L)+ZBRE(LS )) + ZDHZRU=ZBREU/HZREFU + ZDHZRV=ZBREV/HZREFV + HZRUDZ=1./ZDHZRU + HZRVDZ=1./ZDHZRV + DWUD2Z=0.5*WVDELU/ZBREU + DWVD2Z=0.5*WVDELV/ZBREV + DWUDZ=2.*DWUD2Z + DWVDZ=2.*DWVD2Z + DWUDHR=WVDELU/HZREFU + DWVDHR=WVDELV/HZREFV + CDTMPUX=RKZTURB*QWCTMPU + CDTMPVY=RKZTURB*QWCTMPV + JWCBLU=0 + JWCBLV=0 + IF( HZRUDZ.LE.DWUD2Z)THEN + CDTMPU=CDTMPUX/( (1.+ZDHZRU)*LOG(1.+HZRUDZ)-1. ) + JWCBLU=1 + ENDIF + IF( HZRVDZ.LE.DWVD2Z)THEN + CDTMPV=CDTMPVY/( (1.+ZDHZRV)*LOG(1.+HZRVDZ)-1. ) + JWCBLV=1 + ENDIF + IF( HZRUDZ.GT.DWUD2Z.AND.HZRUDZ.LE.DWUDZ)THEN + BOTTMP=(1.+ZDHZRU)*LOG(1.+DWUD2Z)-0.5*DWUDHR + & +0.5*HZRUDZ*(1.-0.5*DWUDHR)*(1.-0.5*DWUDHR)/(1.+DWUD2Z) + CDTMPU=CDTMPUX/BOTTMP + JWCBLU=2 + ENDIF + IF( HZRVDZ.GT.DWVD2Z.AND.HZRVDZ.LE.DWVDZ)THEN + BOTTMP=(1.+ZDHZRV)*LOG(1.+DWVD2Z)-0.5*DWVDHR + & +0.5*HZRVDZ*(1.-0.5*DWVDHR)*(1.-0.5*DWVDHR)/(1.+DWVD2Z) + CDTMPV=CDTMPVY/BOTTMP + JWCBLV=2 + ENDIF + IF( HZRUDZ.GT.DWUDZ)THEN + BOTTMP=QWDQCU*( (1.+ZDHZRU)*(LOG(1.+HZRUDZ)-LOG(1.+DWUDZ)) + & +DWUDHR-1. ) + BOTTMP=BOTTMP+(1.+ZDHZRU)*LOG(1.+DWUD2Z) + & +DWUD2Z*(1.-1.25*DWUDHR-ZDHZRU)/(1.+DWUD2Z) + CDTMPU=CDTMPUX/BOTTMP + JWCBLU=3 + ENDIF + IF( HZRVDZ.GT.DWVDZ)THEN + BOTTMP=QWDQCV*( (1.+ZDHZRV)*(LOG(1.+HZRVDZ)-LOG(1.+DWVDZ)) + & +DWVDHR-1. ) + BOTTMP=BOTTMP+(1.+ZDHZRV)*LOG(1.+DWVD2Z) + & +DWVD2Z*(1.-1.25*DWVDHR-ZDHZRV)/(1.+DWVD2Z) + CDTMPV=CDTMPVY/BOTTMP + JWCBLV=3 + ENDIF + CDTMPU=CDTMPU/UMAGTMP + CDTMPV=CDTMPV/VMAGTMP + IF(DEBUG.AND.MYRANK.EQ.0)THEN + IF(ISDZBR.EQ.N)THEN + WRITE(1,1779) IL(L),JL(L),JWCBLU,JWCBLV + WRITE(1,1780) + WRITE(1,1781) ZBREU,WVDELU,HZREFU,CDTMPU,CDMAXU + WRITE(1,1782) + WRITE(1,1781) ZBREV,WVDELV,HZREFV,CDTMPV,CDMAXV + ENDIF + ENDIF + IF(CDTMPU.LE.0.) CDTMPU=CDMAXU + IF(CDTMPV.LE.0.) CDTMPV=CDMAXV + STBX(L)=AVCON*STBXO(L)*CDTMPU + STBY(L)=AVCON*STBYO(L)*CDTMPV + STBX(L)=MIN(CDMAXU,STBX(L),0.11) + STBY(L)=MIN(CDMAXV,STBY(L),0.11) + ENDIF + ENDDO + MPI_WTIMES(862)=MPI_WTIMES(862)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(DEBUG.AND.MYRANK.EQ.0)THEN + IF(ISDZBR.EQ.N) CLOSE(1) + IF(ISDZBR.GE.1)THEN + DO L=2,LA + IF(ZBRE(L).GT.ZBRMAX)THEN + ZBRMAX=ZBRE(L) + LZBMAX=L + ENDIF + IF(ZBRE(L).LT.ZBRMIN)THEN + ZBRMIN=ZBRE(L) + LZBMIN=L + ENDIF + IF(STBX(L).GT.CDRGMAX)THEN + CDRGMAX=STBX(L) + LCDMAX=L + ENDIF + IF(STBX(L).LT.CDRGMIN)THEN + CDRGMIN=STBX(L) + LCDMIN=L + ENDIF + IF(STBY(L).GT.CDRGMAX)THEN + CDRGMAX=STBY(L) + LCDMAX=L + ENDIF + IF(STBY(L).LT.CDRGMIN)THEN + CDRGMIN=STBY(L) + LCDMIN=L + ENDIF + ENDDO + OPEN(1,FILE='ZBREMX.OUT',STATUS='UNKNOWN',POSITION='APPEND') + HOTLYMX=DZC(1)*H1P(LZBMAX) + HOTLYMN=DZC(1)*H1P(LZBMIN) + WRITE(1,1739)N,IL(LZBMAX),JL(LZBMAX),ZBRMAX,HOTLYMX + WRITE(1,1749)N,IL(LZBMIN),JL(LZBMIN),ZBRMIN,HOTLYMN + WRITE(1,1759)N,IL(LCDMAX),JL(LCDMAX),CDRGMAX,STBX(LCDMAX), + & STBY(LCDMAX) + WRITE(1,1769)N,IL(LCDMIN),JL(LCDMIN),CDRGMIN,STBX(LCDMIN), + & STBY(LCDMIN) + CLOSE(1) + ENDIF + ENDIF + MPI_WTIMES(863)=MPI_WTIMES(863)+MPI_TOC(S1TIME) + + 1948 CONTINUE +C1717 FORMAT(' N,I,J = ',I10,2I5,' CDTOTU,CDMAXU = ',2F15.10) +C1718 FORMAT(' N,I,J = ',I10,2I5,' CDTOTV,CDMAXV = ',2F15.10) +C1727 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTU,CDMAXU = ',2F15.10) +C1728 FORMAT(' N,I,J = ',I10,2I5,' LAM CDTOTV,CDMAXV = ',2F15.10) +C1719 FORMAT(' N = ',I10,' CDTOTUM,CDTOTVM = ',2F15.10) +C1729 FORMAT(' N = ',I10,' CDMAXUM,CDMAXVM = ',2F15.10) + 1739 FORMAT(' N,I,J = ',I10,2I5,' ZBRMAX,HBTLYMX = ',2E14.6) + 1749 FORMAT(' N,I,J = ',I10,2I5,' ZBRMIN,HBTLYMN = ',2E14.6) + 1759 FORMAT(' N,I,J = ',I10,2I5,' CDRGMAX,STBX,STBY = ',3E14.6) + 1769 FORMAT(' N,I,J = ',I10,2I5,' CDRGMIN,STBX,STBY = ',3E14.6) + 1779 FORMAT(' I, J, JWCBLU, JWCBLV = ',4I8) + 1780 FORMAT(' ZBREU WVDELU HZREFU CDTMPU ', + & 1X,' CDMAXU') + 1781 FORMAT(5E12.4) + 1782 FORMAT(' ZBREV WVDELV HZREFV CDTMPV ', + & 1X,' CDMAXV') + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN_mpi.for new file mode 100644 index 000000000..505ce6d6c --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN_mpi.for @@ -0,0 +1,1788 @@ + SUBROUTINE CALTRAN_mpi (ISTL_,IS2TL_,MVAR,MO,CON,CON1) +C +C CHANGE RECORD +C ADDED TRANSPORT BYPASS MASK, IMASKDRY FOR DRY CELLS +C ** SUBROUTINE CALTRAN CALCULATES THE ADVECTIVE +C ** TRANSPORT OF DISSOLVED OR SUSPENDED CONSITITUENT M LEADING TO +C ** A NEW VALUE AT TIME LEVEL (N+1). THE VALUE OF ISTL INDICATES +C ** THE NUMBER OF TIME LEVELS IN THE STEP +C + USE GLOBAL + USE MPI + + DIMENSION CON(LCM,KCM),CON1(LCM,KCM) + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMN + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMX +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FQCPAD +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::POS + + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::WQBCCON + REAL CTMP + CTMP=0.0 + + IF(.NOT.ALLOCATED(CONTMN))THEN + ALLOCATE(CONTMN(LCM,KCM)) + ALLOCATE(CONTMX(LCM,KCM)) + ALLOCATE(FQCPAD(LCM,KCM)) + ALLOCATE(QSUMNAD(LCM,KCM)) + ALLOCATE(QSUMPAD(LCM,KCM)) + ALLOCATE(POS(LCM,KCM)) + ALLOCATE(WQBCCON(LCM,KCM)) + + DO L=1,LC + FWU(L,0)=0. + FWU(L,KC)=0. + ENDDO + CONTMN=0.0 + CONTMX=0.0 + FQCPAD=0.0 + QSUMNAD=0.0 ! *** NOT USED + QSUMPAD=0.0 + POS=0.0 + WQBCCON=0.0 + ENDIF +C + BSMALL=1.0E-6 + ISUD=1 + IF(ISDYNSTP.EQ.0)THEN + DELT=DT2 + DELTA=DT2 + IF(ISCDCA(MVAR).EQ.2) DELTA=DT + DELTD2=DT + IF(ISTL_.NE.3)THEN + DELT=DT + DELTA=DT + DELTD2=0.5*DT + IF(IS2TIM.EQ.0)ISUD=0 ! *** PMC SINGLE LINE CHANGE + ENDIF + ELSE + DELT=DTDYN + DELTA=DTDYN + DELTD2=0.5*DTDYN + END IF + DELTA4=0.25*DELTA + + S3TIME=MPI_TIC() + ! *** DSLLC BEGIN + M=MO + IF(IS2TL_.EQ.1)THEN + ISUD=1 + IF(MVAR.NE.8)THEN ! *** ARRAYS + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON1(L,K)=CON(L,K) + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(650)=MPI_WTIMES(650)+MPI_TOC(S3TIME) + + S3TIME=MPI_TIC() + ! *** SAVE OLD WQ CONCENTRATIONS FOR OPEN BOUNDARY CELLS + IF(MVAR.EQ.8)THEN + DO IOBC=1,NBCSOP + L=LOBCS(IOBC) + DO K=1,KC + WQBCCON(L,K)=CON(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(651)=MPI_WTIMES(651)+MPI_TOC(S3TIME) + + ! *** DSLLC END +C +C ** CALCULATED EXTERNAL SOURCES AND SINKS +C + S3TIME=MPI_TIC() + CALL CALFQC_mpi (ISTL_,IS2TL_,MVAR,M,CON,CON1)!, +! & FQCPAD,QSUMPAD,QSUMNAD) + MPI_WTIMES(652)=MPI_WTIMES(652)+MPI_TOC(S3TIME) +C +C +C ** SELECT TRANSPORT OPTION, ISPLIT=1 FOR HORIZONTAL-VERTICAL +C ** OPERATOR SPLITTING +C ** BEGIN COMBINED ADVECTION SCHEME +C ** ADVECTIVE FLUX CALCULATION +C + IF(ISTL_.EQ.2) GOTO 300 + IF(ISCDCA(MVAR).EQ.0) GOTO 300 + IF(ISCDCA(MVAR).EQ.1) GOTO 400 + IF(ISCDCA(MVAR).EQ.2) GOTO 350 +C +C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH ADVECTION +C ** AVERAGED BETWEEN (N) AND (N+1) OR (N-1) AND (N+1) AND ADVECTED +C ** AT (N) OR (N-1) IF ISTL EQUALS 2 OR 3 RESPECTIVELY +C + 300 CONTINUE +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CON1,ic) + MPI_WTIMES(692)=MPI_WTIMES(692)+MPI_TOC(S3TIME) + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + call collect_in_zero_array(UHDY2 ) + call collect_in_zero_array(VHDX2 ) + call collect_in_zero_array(CON1 ) + call collect_in_zero_array(W2 ) + IF(MYRANK.EQ.0) PRINT*, '0FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '0FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '0FWU = ', sum(abs(dble(FWU ))) + IF(MYRANK.EQ.0) PRINT*, '0UHDY2 = ', sum(abs(dble(UHDY2 ))) + IF(MYRANK.EQ.0) PRINT*, '0VHDX2 = ', sum(abs(dble(VHDX2 ))) + IF(MYRANK.EQ.0) PRINT*, '0CON1 = ', sum(abs(dble(CON1 ))) + IF(MYRANK.EQ.0) PRINT*, '0W2 = ', sum(abs(dble(W2 ))) + endif + call mpi_barrier(mpi_comm_world,ierr) + + S3TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FUHU(L,K)=UHDY2(L,K)*CON1(LUPU(L,K),K) + FVHU(L,K)=VHDX2(L,K)*CON1(LUPV(L,K),K) + ENDDO + ENDDO + IF(KC.GT.1)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,K)=W2(L,K)*CON1(L,KUPW(L,K)) + ENDDO + ENDDO + ENDIF + ELSE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FUHU(L,K)=UHDY2(L,K)*CON1(LUPU(L,K),K) + FVHU(L,K)=VHDX2(L,K)*CON1(LUPV(L,K),K) + ELSE + FUHU(L,K)=0. + FVHU(L,K)=0. + ENDIF + ENDDO + ENDDO + IF(KC.GT.1)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FWU(L,K)=W2(L,K)*CON1(L,KUPW(L,K)) + ELSE + FWU(L,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(653)=MPI_WTIMES(653)+MPI_TOC(S3TIME) +C + call mpi_barrier(mpi_comm_world,ierr) + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '1FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '1FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '1FWU = ', sum(abs(dble(FWU ))) + if(n.eq.12.and.myrank.eq.0)then + do l=2,lcm ; do k=1,kcm + print*, l,k,fvhu(l,k) + enddo ; enddo + endif + endif + + GOTO 500 +C +C ** CALCULATE ADVECTIVE FLUXES BY UPWIND DIFFERENCE WITH ADVECTION +C ** AVERAGED BETWEEN (N-1) AND (N+1) AND ADVECTED FIELD AVERAGED +C ** BETWEEN AT (N-1) AND (N) IF ISTL 3 ONLY +C + 350 CONTINUE +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CONT,ic) + MPI_WTIMES(692)=MPI_WTIMES(692)+MPI_TOC(S3TIME) + + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CONT(L,K)=0.5*(CON(L,K)+CON1(L,K)) + & +DELT*0.5*FQC(L,K)*DXYIP(L)/H2P(L) + ENDDO + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FUHU(L,K)=UHDY2(L,K)*CONT(LUPU(L,K),K) + FVHU(L,K)=VHDX2(L,K)*CONT(LUPV(L,K),K) + ENDDO + ENDDO + IF(KC.GT.1)THEN + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,K)=W2(L,K)*CONT(L,KUPW(L,K)) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(654)=MPI_WTIMES(654)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '2FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '2FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '2FWU = ', sum(abs(dble(FWU ))) + endif + GOTO 500 +C +C ** CALCULATE ADVECTIVE FLUXES BY CENTRAL DIFFERENCE WITH TRANSPORT +C ** AVERAGED BETWEEN (N+1) AND (N-1) AND TRANSPORTED FIELD AT (N) +C + 400 CONTINUE +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CON,ic) + MPI_WTIMES(692)=MPI_WTIMES(692)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FUHU(L,K)=0.5*UHDY2(L,K)*(CON(L,K)+CON(L-1,K)) + FVHU(L,K)=0.5*VHDX2(L,K)*(CON(L,K)+CON(LS,K)) + ENDDO + ENDDO + MPI_WTIMES(655)=MPI_WTIMES(655)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(VHDX2,ic) + CALL broadcast_boundary_array(UHDY2,ic) + MPI_WTIMES(693)=MPI_WTIMES(693)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + IF(VHDX2(LN,K).LT.0.) FVHU(LN,K)=VHDX2(LN,K)*CON1(LN,K) + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + IF(UHDY2(L+1,K).LT.0.) FUHU(L+1,K)=UHDY2(L+1,K)*CON1(L+1,K) + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + IF(UHDY2(L,K).GT.0.) FUHU(L,K)=UHDY2(L,K)*CON1(L-1,K) + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + LS =LSC(L) + IF(VHDX2(L,K).GT.0.) FVHU(L,K)=VHDX2(L,K)*CON1(LS,K) + ENDDO + ENDDO + MPI_WTIMES(656)=MPI_WTIMES(656)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,K)=0.5*W2(L,K)*(CON(L,K+1)+CON(L,K)) + ENDDO + ENDDO + MPI_WTIMES(657)=MPI_WTIMES(657)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '3FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '3FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '3FWU = ', sum(abs(dble(FWU ))) + endif +C ** STANDARD ADVECTION CALCULATION +C + 500 CONTINUE +C +C BEGIN IF ON TRANSPORT OPTION CHOICE +C + ! *** CALCULATE AND ADD HORIZONTAL DIFFUSION FLUX (PMC MOVED) + S3TIME=MPI_TIC() + IF(ISHDMF.EQ.2) CALL CALDIFF_mpi (ISTL_,M,CON1) + MPI_WTIMES(658)=MPI_WTIMES(658)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FWU,ic) + MPI_WTIMES(694)=MPI_WTIMES(694)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + call collect_in_zero_array(CON1 ) + call collect_in_zero_array(FQC ) + call collect_in_zero(H1P ) + call COLLECT_IN_ZERO_INT(IMASKDRY) + IF(MYRANK.EQ.0) PRINT*, 'FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, 'FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, 'FWU = ', sum(abs(dble(FWU ))) + IF(MYRANK.EQ.0) PRINT*, 'CON1 = ', sum(abs(dble(CON1 ))) + IF(MYRANK.EQ.0) PRINT*, 'FQC = ', sum(abs(dble(FQC ))) + IF(MYRANK.EQ.0) PRINT*, 'H1P = ', sum(abs(dble(H1P ))) + IF(MYRANK.EQ.0) PRINT*, 'IMASKDRY= ',sum(abs(dble(IMASKDRY ))) + endif + + ! *** IF ISACAC EQ 0 INCLUDE FQC MASS SOURCES IN UPDATE + IF(ISCDCA(MVAR).EQ.0)THEN + IF(ISTL_.EQ.2)THEN +C + S3TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( RDZIC*FQC(L,K) + & +FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + ENDDO + ENDDO + ELSE + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'cc','CH = ', sum(abs(dble(CH))) + endif + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(IMASKDRY(L).EQ.0) + & CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( RDZIC*FQC(L,K)+FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + IF(IMASKDRY(L).EQ.1) + & CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( FQC(L,K) )*DXYIP(L) ) + IF(IMASKDRY(L).EQ.2) + & CH(L,K)=CON1(L,K)*H1P(L) + ENDDO + ENDDO + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'c0','CH = ', sum(abs(dble(CH))) + endif + ENDIF + IF(ISFCT(MVAR).GE.1.AND.ISADAC(MVAR).GT.0)THEN ! *** DSLLC SINGLE LINE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON2(L,K)=CON1(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(659)=MPI_WTIMES(659)+MPI_TOC(S3TIME) +C +C ELSE ON TIME LEVEL CHOICE FOR ISCDCA=0 +C + ELSE +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CH(L,K)=CON1(L,K)*H2P(L) + & +DELT*( ( RDZIC*FQC(L,K) + & +FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + ENDDO + ENDDO + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'c1','CH = ', sum(abs(dble(CH))) + endif + IF(ISFCT(MVAR).GE.1.AND.ISADAC(MVAR).GT.0)THEN ! *** DSLLC SINGLE LINE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON2(L,K)=CON(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(660)=MPI_WTIMES(660)+MPI_TOC(S3TIME) +C + ENDIF +C + if(PRINT_SUM)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + IF(MYRANK.EQ.0)THEN + IF(MO.LE.NWQV)PRINT*, n,'h11WQV = ', sum(abs(dble(WQV))),mo + ENDIF + ENDIF +C ENDIF ON TIME LEVEL CHOICE FOR ISCDCA=0 +C + IF(ISUD.EQ.1.AND.IS2TL_.EQ.0.AND.MVAR.NE.8)THEN + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(L) + DO IOBC=1,NBCSOP + L=LOBCS(IOBC) + IF(ISDOMAIN(L))THEN + CON(L,K)=CON1(L,K) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(661)=MPI_WTIMES(661)+MPI_TOC(S3TIME) + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON1(L,K)=CON(L,K) + ENDDO + ENDDO + MPI_WTIMES(662)=MPI_WTIMES(662)+MPI_TOC(S3TIME) + ENDIF + ! *** UPDATE NEW CONCENTRATIONS + S3TIME=MPI_TIC() +C DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON(L,1:KC)=CH(L,1:KC)*HPI(L) + ENDDO +C ENDDO + MPI_WTIMES(663)=MPI_WTIMES(663)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CON) + call collect_in_zero(HPI) + IF(MYRANK.EQ.0) PRINT*, 'd1','CON = ', sum(abs(dble(CON))) + IF(MYRANK.EQ.0) PRINT*, 'e1','HPI = ', sum(abs(dble(HPI))) + endif +C *** ELSE ON TRANSPORT OPTION CHOICE +C *** IF ISACAC NE 0 DO NOT INCLUDE FQC MASS SOURCES IN UPDATE +C + ELSE +C +C BEGIN IF ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 +C + IF(ISTL_.EQ.2)THEN +C + S3TIME=MPI_TIC() + IF(IDRYTBP.EQ.0)THEN + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( RDZIC*FQC(L,K) + & +FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + ENDDO + ENDDO + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'c2','CH = ', sum(abs(dble(CH))) + endif + ELSE + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(IMASKDRY(L).EQ.0) + & CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( RDZIC*FQC(L,K) + & +FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + IF(IMASKDRY(L).EQ.1) + & CH(L,K)=CON1(L,K)*H1P(L) + & +DELT*( ( FQC(L,K) )*DXYIP(L) ) + IF(IMASKDRY(L).EQ.2) + & CH(L,K)=CON1(L,K)*H1P(L) + ENDDO + ENDDO + ENDIF + IF(ISFCT(MVAR).GE.1)THEN + CON2=CON1 ! *** ARRAYS + ENDIF + MPI_WTIMES(664)=MPI_WTIMES(664)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'c3','CH = ', sum(abs(dble(CH))) + endif +C ELSE ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 AND ISTL.EQ.3 +C + ELSE +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CH(L,K)=CON1(L,K)*H2P(L) + & +DELT*( ( RDZIC*FQC(L,K)+FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + ENDDO + ENDDO + IF(ISFCT(MVAR).GE.1)THEN + CON2=CON ! *** ARRAYS + ENDIF + MPI_WTIMES(664)=MPI_WTIMES(664)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CH) + IF(MYRANK.EQ.0) PRINT*, 'c4','CH = ', sum(abs(dble(CH))) + endif + ENDIF +C +C ENDIF ON TIME LEVEL CHOICE FOR ISCDCA.NE.0 +C + S3TIME=MPI_TIC() + IF(ISUD.EQ.1.AND.MVAR.NE.8)THEN + DO K=1,KC + DO IOBC=1,NBCSOP + L=LOBCS(IOBC) + CON(L,K)=CON1(L,K) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON1(L,K)=CON(L,K) + ENDDO + ENDDO + ENDIF + ! *** PMC-BOUNDARY CONDITIONS APPLIED BELOW + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CON(L,K)=CH(L,K)*HPI(L) + ENDDO + ENDDO + MPI_WTIMES(664)=MPI_WTIMES(664)+MPI_TOC(S3TIME) + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(CON) + call collect_in_zero(HPI) + IF(MYRANK.EQ.0) PRINT*, 'd2','CON = ', sum(abs(dble(CON))) + IF(MYRANK.EQ.0) PRINT*, 'e2','HPI = ', sum(abs(dble(HPI))) + endif +C + ENDIF +C +C ENDIF ON TRANSPORT OPTION CHOICE +C +C *** APPLY OPEN BOUNDARY CONDITIONS, BASED ON DIRECTION OF FLOW +C + ! *** ALL OTHER WATER CONSTITUENTS + S3TIME=MPI_TIC() + IF(MVAR.EQ.8)THEN !.AND.IWQPSL.EQ.2)THEN + M=4+NTOX+NSED+NSND+MO + ! *** RESTORE ORIGINAL CONCENTRATIONS PRIOR TO APPLYING OPEN BC'S + DO K=1,KC + DO IOBC=1,NBCSOP + L=LOBCS(IOBC) + CON1(L,K)=WQBCCON(L,K) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(665)=MPI_WTIMES(665)+MPI_TOC(S3TIME) +C + ! *** SOUTH OPEN BC + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + IF(ISDOMAIN(LCBS(LL)))THEN + NSID=NCSERS(LL,M) + L=LCBS(LL) + LN=LNC(L) + IF(VHDX2(LN,K).LE.0.)THEN + ! *** FLOWING OUT OF DOMAIN + IF(ISTL_.EQ.2)THEN + CTMP=CON1(L,K)+DELT*(VHDX2(LN,K)*CON1(L,K) + & -FVHU(LN,K))*DXYIP(L)*HPI(L) + ELSE + IF(ISCDCA(MVAR).NE.2)CTMP=CON1(L,K)+DELT*(VHDX2(LN,K) + & *CON1(L,K)-FVHU(LN,K))*DXYIP(L)*HPI(L) + IF(ISCDCA(MVAR).EQ.2) CTMP=0.5*(CON1(L,K)+CON(L,K)) + & +0.5*(CON1(L,K)-CON(L,K))*H2P(L)*HPI(L) + & +DELT*(0.5*VHDX2(LN,K)*(CON1(L,K)+CON(L,K)) + & -FVHU(LN,K))*DXYIP(L)*HPI(L) + CON1(L,K)=CON(L,K) + ENDIF + CON(L,K)=CTMP + CBSTMP=CBS(LL,1,M)+CSERT(1,NSID,M) + IF(M.EQ.1.AND.CON(L,K).GT.CBSTMP)THEN + CON(L,K)=CBSTMP + ENDIF + CLOS(LL,K,M)=CON(L,K) + NLOS(LL,K,M)=N + ELSE + ! *** FLOWING INTO DOMAIN + IF(ISUD.EQ.1) CON1(L,K)=CON(L,K) + CBT=WTCI(K,1)*CBS(LL,1,M)+WTCI(K,2)*CBS(LL,2,M)+CSERT( + & K,NSID,M) + NMNLO=N-NLOS(LL,K,M) + IF(NMNLO.GE.NTSCRS(LL))THEN + CON(L,K)=CBT + ELSE + CON(L,K)=CLOS(LL,K,M) + & +(CBT-CLOS(LL,K,M))*FLOAT(NMNLO)/FLOAT(NTSCRS(LL)) + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(666)=MPI_WTIMES(666)+MPI_TOC(S3TIME) +C + ! *** WEST OPEN BC + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBW + IF(ISDOMAIN(LCBW(LL)))THEN + NSID=NCSERW(LL,M) + L=LCBW(LL) + IF(UHDY2(L+1,K).LE.0.)THEN + ! *** FLOWING OUT OF DOMAIN + IF(ISTL_.EQ.2)THEN + CTMP=CON1(L,K)+DELT*(UHDY2(L+1,K)*CON1(L,K) + & -FUHU(L+1,K))*DXYIP(L)*HPI(L) + ELSE + IF(ISCDCA(MVAR).NE.2) CTMP=CON1(L,K) + & +DELT*(UHDY2(L+1,K)*CON1(L,K)-FUHU(L+1,K))*DXYIP(L) + & *HPI(L) + IF(ISCDCA(MVAR).EQ.2) CTMP=0.5*(CON1(L,K)+CON(L,K)) + & +0.5*(CON1(L,K)-CON(L,K))*H2P(L)*HPI(L) + & +DELT*(0.5*UHDY2(L+1,K)*(CON1(L,K)+CON(L,K)) + & -FUHU(L+1,K))*DXYIP(L)*HPI(L) + CON1(L,K)=CON(L,K) + ENDIF + CON(L,K)=CTMP + CBWTMP=CBW(LL,1,M)+CSERT(1,NSID,M) + IF(M.EQ.1.AND.CON(L,K).GT.CBWTMP) CON(L,K)=CBWTMP + CLOW(LL,K,M)=CON(L,K) + NLOW(LL,K,M)=N + ELSE + ! *** FLOWING INTO DOMAIN + IF(ISUD.EQ.1) CON1(L,K)=CON(L,K) + CBT=WTCI(K,1)*CBW(LL,1,M)+WTCI(K,2)*CBW(LL,2,M)+CSERT( + & K,NSID,M) + NMNLO=N-NLOW(LL,K,M) + IF(NMNLO.GE.NTSCRW(LL))THEN + CON(L,K)=CBT + ELSE + CON(L,K)=CLOW(LL,K,M) + & +(CBT-CLOW(LL,K,M))*FLOAT(NMNLO)/FLOAT(NTSCRW(LL)) + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(667)=MPI_WTIMES(667)+MPI_TOC(S3TIME) +C + ! *** EAST OPEN BC + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBE + IF(ISDOMAIN(LCBE(LL)))THEN + NSID=NCSERE(LL,M) + L=LCBE(LL) + IF(UHDY2(L,K).GE.0.)THEN + ! *** FLOWING OUT OF DOMAIN + IF(ISTL_.EQ.2)THEN + CTMP=CON1(L,K)+DELT*(FUHU(L,K) + & -UHDY2(L,K)*CON1(L,K))*DXYIP(L)*HPI(L) + ELSE + IF(ISCDCA(MVAR).NE.2) CTMP=CON1(L,K)+DELT*(FUHU(L,K) + & -UHDY2(L,K)*CON1(L,K))*DXYIP(L)*HPI(L) + IF(ISCDCA(MVAR).EQ.2) CTMP=0.5*(CON1(L,K)+CON(L,K)) + & +0.5*(CON1(L,K)-CON(L,K))*H2P(L)*HPI(L)+DELT*(FUHU(L,K) + & -0.5*UHDY2(L,K)*(CON1(L,K)+CON(L,K)))*DXYIP(L)*HPI(L) + CON1(L,K)=CON(L,K) + ENDIF + CON(L,K)=CTMP + CBETMP=CBE(LL,1,M)+CSERT(1,NSID,M) + IF(M.EQ.1.AND.CON(L,K).GT.CBETMP) CON(L,K)=CBETMP + CLOE(LL,K,M)=CON(L,K) + NLOE(LL,K,M)=N + ELSE + ! *** FLOWING INTO DOMAIN + IF(ISUD.EQ.1) CON1(L,K)=CON(L,K) + CBT=WTCI(K,1)*CBE(LL,1,M)+WTCI(K,2)*CBE(LL,2,M)+CSERT( + & K,NSID,M) + NMNLO=N-NLOE(LL,K,M) + IF(NMNLO.GE.NTSCRE(LL))THEN + CON(L,K)=CBT + ELSE + CON(L,K)=CLOE(LL,K,M) + & +(CBT-CLOE(LL,K,M))*FLOAT(NMNLO)/FLOAT(NTSCRE(LL)) + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(668)=MPI_WTIMES(668)+MPI_TOC(S3TIME) +C + ! *** NORTH OPEN BC + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBN + IF(ISDOMAIN(LCBN(LL)))THEN + NSID=NCSERN(LL,M) + L=LCBN(LL) + LS=LSC(L) +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f1',nsid,l,ls + IF(VHDX2(L,K).GE.0.)THEN + ! *** FLOWING OUT OF DOMAIN + IF(ISTL_.EQ.2)THEN + CTMP=CON1(L,K)+DELT*(FVHU(L,K) + & -VHDX2(L,K)*CON1(L,K))*DXYIP(L)*HPI(L) +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f2',ctmp + ELSE + IF(ISCDCA(MVAR).NE.2) CTMP=CON1(L,K)+DELT*(FVHU(L,K) + & -VHDX2(L,K)*CON1(L,K))*DXYIP(L)*HPI(L) + IF(ISCDCA(MVAR).EQ.2) CTMP=0.5*(CON1(L,K)+CON(L,K)) + & +0.5*(CON1(L,K)-CON(L,K))*H2P(L)*HPI(L)+DELT*(FVHU(L,K) + & -0.5*VHDX2(L,K)*(CON1(L,K)+CON(L,K)))*DXYIP(L)*HPI(L) + CON1(L,K)=CON(L,K) +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f3',ctmp + ENDIF + CON(L,K)=CTMP + CBNTMP=CBN(LL,1,M)+CSERT(1,NSID,M) +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f4',CON(L,K) + IF(M.EQ.1.AND.CON(L,K).GT.CBNTMP) CON(L,K)=CBNTMP +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f5',CON(L,K) + CLON(LL,K,M)=CON(L,K) + NLON(LL,K,M)=N + ELSE + ! *** FLOWING INTO DOMAIN + IF(ISUD.EQ.1) CON1(L,K)=CON(L,K) + CBT=WTCI(K,1)*CBN(LL,1,M)+WTCI(K,2)*CBN(LL,2,M)+CSERT( + & K,NSID,M) + NMNLO=N-NLON(LL,K,M) + IF(NMNLO.GE.NTSCRN(LL))THEN + CON(L,K)=CBT +! if(lcbn(ll).eq.16759.and.k.eq.1) print*,'f7',CON(L,K) + ELSE + CON(L,K)=CLON(LL,K,M) + & +(CBT-CLON(LL,K,M))*FLOAT(NMNLO)/FLOAT(NTSCRN(LL)) + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + MPI_WTIMES(669)=MPI_WTIMES(669)+MPI_TOC(S3TIME) +C +C ** ANTI-DIFFUSIVE ADVECTIVE FLUX CALCULATION +C + IF(ISADAC(MVAR).EQ.0) GOTO 2000 + IF(ISCDCA(MVAR).EQ.1) GOTO 2000 + IF(ISFCT(MVAR).GT.0)THEN + ! *** DU & DV are used as a temporary array in this sub + DO K=1,KC + DU(1,K)=0. + DV(1,K)=0. + DU(LC,K)=0. + DV(LC,K)=0. + ENDDO + ENDIF +C +C ** STANDARD ANTI-DIFFUSIVE ADVECTIVE FLUX CALCULATION +C + ! *** PMC BEGIN BLOCK + ! *** GET ONLY POSITIVE CONCENTRATIONS + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + POS(L,K)=MAX(CON(L,K),0.) + ENDDO + ENDDO + CALL broadcast_boundary_array(POS,ic) + MPI_WTIMES(670)=MPI_WTIMES(670)+MPI_TOC(S3TIME) + ! *** PMC END BLOCK +C + IF(IDRYTBP.EQ.0)THEN + S3TIME=MPI_TIC() + DO K=1,KC + UUU(LC,K)=0.0 + VVV(LC,K)=0.0 + UUU(1,K)=0.0 + VVV(1,K)=0.0 + ENDDO +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + WWW(L,0)=0.0 + WWW(L,KC)=0.0 + ENDDO +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + UUU(L,K)=U2(L,K)*(POS(L,K)-POS(L-1,K))*DXIU(L) + VVV(L,K)=V2(L,K)*(POS(L,K)-POS(LS,K))*DYIV(L) + ENDDO + ENDDO + DO K=1,KS + RDZIG=DZIG(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WWW(L,K)=W2(L,K)*(POS(L,K+1)-POS(L,K))*HPI(L)*RDZIG + ENDDO + ENDDO + MPI_WTIMES(671)=MPI_WTIMES(671)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(UUU,ic) + CALL broadcast_boundary_array(VVV,ic) + CALL broadcast_boundary_array(WWW,ic) + MPI_WTIMES(696)=MPI_WTIMES(696)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CON,ic) + CALL broadcast_boundary_array(CON1,ic) + MPI_WTIMES(695)=MPI_WTIMES(695)+MPI_TOC(S3TIME) + + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(FQCPAD,ic) + CALL broadcast_boundary_array(QSUMPAD,ic) + MPI_WTIMES(695)=MPI_WTIMES(695)+MPI_TOC(S3TIME) + + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO PRIVATE(LN,LS,LNW,LSE,AUHU,AVHV,UTERM,VTERM, +!$OMP+ SSCORUE,SSCORUW,SSCORVN,SSCORVS,SSCORU,SSCORV,UHU,VHV) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + AUHU=ABS(UHDY2(L,K)) + AVHV=ABS(VHDX2(L,K)) + UTERM=AUHU*(POS(L,K)-POS(L-1,K)) + VTERM=AVHV*(POS(L,K)-POS(LS,K)) + IF(ISADAC(MVAR).GE.2)THEN + SSCORUE=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORUW=DELTA*RDZIC*DXYIP(L-1)*HPI(L-1)*(FQCPAD(L-1,K) + & -QSUMPAD(L-1,K)*CON(L-1,K)) + SSCORVN=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORVS=DELTA*RDZIC*DXYIP(LS )*HPI(LS )*(FQCPAD(LS ,K) + & -QSUMPAD(LS ,K)*CON(LS ,K)) + SSCORU=MAX(UHDY2(L,K),0.0)*SSCORUW+MIN(UHDY2(L,K),0.0) + & *SSCORUE + SSCORV=MAX(VHDX2(L,K),0.0)*SSCORVS+MIN(VHDX2(L,K),0.0) + & *SSCORVN + UTERM=UTERM+SSCORU + VTERM=VTERM+SSCORV + ENDIF + IF(UHDY2(L,K).GE.0.0)THEN + UTERM=UTERM-0.5*DELTA*UHDY2(L,K)* + & (VVV(LNW,K)+VVV(L-1,K)+WWW(L-1,K)+WWW(L-1,K-1) + & +UUU(L,K)+UUU(L-1,K)) + ELSE + UTERM=UTERM-0.5*DELTA*UHDY2(L,K)* + & (VVV(LN,K)+VVV(L,K)+WWW(L,K)+WWW(L,K-1) + & +UUU(L,K)+UUU(L+1,K)) + ENDIF + IF(VHDX2(L,K).GE.0.0)THEN + VTERM=VTERM-0.5*DELTA*VHDX2(L,K)* + & (UUU(LS,K)+UUU(LSE,K)+WWW(LS,K)+WWW(LS,K-1) + & +VVV(LS,K)+VVV(L,K)) + ELSE + VTERM=VTERM-0.5*DELTA*VHDX2(L,K)* + & (UUU(L,K)+UUU(L+1,K)+WWW(L,K)+WWW(L,K-1) + & +VVV(LN,K)+VVV(L,K)) + ENDIF + IF(ISFCT(MVAR).GE.2)THEN + FUHU(L,K)=0.5*UTERM + FVHU(L,K)=0.5*VTERM + IF(ISFCT(MVAR).EQ.3)THEN + FUHU(L,K)=UTERM + FVHU(L,K)=VTERM + ENDIF + ELSE + UHU=UTERM/(POS(L,K)+POS(L-1,K)+BSMALL) + VHV=VTERM/(POS(L,K)+POS(LS,K)+BSMALL) + FUHU(L,K)=MAX(UHU,0.)*POS(L-1,K) + & +MIN(UHU,0.)*POS(L,K) + FVHU(L,K)=MAX(VHV,0.)*POS(LS,K) + & +MIN(VHV,0.)*POS(L,K) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(672)=MPI_WTIMES(672)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,AWW,WTERM,SSCORWA,SSCORWB,SSCORW,WW) + DO L=LMPI2,LMPILA + LN=LNC(L) + AWW=ABS(W2(L,K)) + WTERM=AWW*(POS(L,K+1)-POS(L,K)) + IF(ISADAC(MVAR).GE.2)THEN + SSCORWA=DELTA*DZIG(K+1)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K+1)-QSUMPAD(L,K+1)*POS(L,K+1)) + SSCORWB=DELTA*DZIG(K)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K )-QSUMPAD(L,K )*POS(L,K )) + SSCORW=MAX(W2(L,K),0.0)*SSCORWB+MIN(W2(L,K),0.0)*SSCORWA + WTERM=WTERM+SSCORW + ENDIF + IF(W2(L,K).GE.0.0)THEN + WTERM=WTERM-0.5*DELTA*W2(L,K)* + & (UUU(L,K)+UUU(L+1,K)+VVV(L,K)+VVV(LN,K) + & +WWW(L,K)+WWW(L,K-1)) + ELSE + WTERM=WTERM-0.5*DELTA*W2(L,K)* + & (UUU(L+1,K+1)+UUU(L,K+1)+VVV(LN,K+1)+VVV(L,K+1) + & +WWW(L,K)+WWW(L,K+1)) + ENDIF + IF(ISFCT(MVAR).GE.2)THEN + FWU(L,K)=0.5*WTERM + IF(ISFCT(MVAR).EQ.3)THEN + FWU(L,K)=WTERM + ENDIF + ELSE + WW=WTERM/(POS(L,K+1)+POS(L,K)+BSMALL) + FWU(L,K)=MAX(WW,0.)*POS(L,K) + & +MIN(WW,0.)*POS(L,K+1) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(673)=MPI_WTIMES(673)+MPI_TOC(S3TIME) +C +C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR SOURCE CELLS +C + S3TIME=MPI_TIC() + IF(ISADAC(MVAR).EQ.1)THEN + ! *** ANTIDIFFUSION TURNED OFF FOR SOURCE CELLS + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN,LS) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + IF(QSUMPAD(L,K).GT.0.0)THEN + FUHU(L ,K)=0. + FUHU(L+1,K)=0. + FVHU(L ,K)=0. + FVHU(LN ,K)=0. + FWU(L,K )=0. + FWU(L,K-1)=0. + ENDIF + IF(QSUMPAD(LS,K).GT.0.0)THEN ! MPI + FVHU(L ,K)=0. + ENDIF + IF(QSUMPAD(L-1,K).GT.0.0)THEN ! MPI + FUHU(L ,K)=0. + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(674)=MPI_WTIMES(674)+MPI_TOC(S3TIME) +C +C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR OPEN BOUNDARY CELLS +C + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + FVHU(LN,K)=0.0 + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + FUHU(L+1,K)=0.0 + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + FUHU(L,K)=0.0 + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + FVHU(L,K)=0.0 + ENDDO + ENDDO + MPI_WTIMES(675)=MPI_WTIMES(675)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FWU,ic) + MPI_WTIMES(697)=MPI_WTIMES(697)+MPI_TOC(S3TIME) +C +C ** CALCULATE AND APPLY FLUX CORRECTED TRANSPORT LIMITERS +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(con) + IF(MYRANK.EQ.0) PRINT*, 'cn1','con = ', sum(abs(dble(con))) + endif + + IF(ISFCT(MVAR).EQ.0) GOTO 1100 +C +C ** DETERMINE MAX AND MIN CONCENTRATIONS +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + CONTMX(L,K)=0.0 + CONTMN(L,K)=0.0 + ENDDO + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CONTMX(L,K)=MAX(CON(L,K),CON2(L,K)) + CONTMN(L,K)=MIN(CON(L,K),CON2(L,K)) + ENDDO + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CMAX(L,1)=MAX(CONTMX(L,1),CONTMX(L,2)) + CMAX(L,KC)=MAX(CONTMX(L,KS),CONTMX(L,KC)) + CMIN(L,1)=MIN(CONTMN(L,1),CONTMN(L,2)) + CMIN(L,KC)=MIN(CONTMN(L,KS),CONTMN(L,KC)) + ENDDO + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CMAXT=MAX(CONTMX(L,K-1),CONTMX(L,K+1)) + CMAX(L,K)=MAX(CONTMX(L,K),CMAXT) + CMINT=MIN(CONTMN(L,K-1),CONTMN(L,K+1)) + CMIN(L,K)=MIN(CONTMN(L,K),CMINT) + ENDDO + ENDDO + MPI_WTIMES(676)=MPI_WTIMES(676)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CONTMX,ic) + CALL broadcast_boundary_array(CONTMN,ic) + MPI_WTIMES(698)=MPI_WTIMES(698)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS,LN,CWMAX,CEMAX,CSMAX,CNMAX,CMAXT, +!$OMP+ CWMIN,CEMIN,CSMIN,CNMIN,CMINT) + DO L=LMPI2,LMPILA + LS=LSC(L) + LN=LNC(L) + CWMAX=SUB(L)*CONTMX(L-1,K) + CEMAX=SUB(L+1)*CONTMX(L+1,K) + CSMAX=SVB(L)*CONTMX(LS,K) + CNMAX=SVB(LN)*CONTMX(LN,K) + CMAXT=MAX(CNMAX,CEMAX) + CMAXT=MAX(CMAXT,CSMAX) + CMAXT=MAX(CMAXT,CWMAX) + CMAX(L,K)=MAX(CMAX(L,K),CMAXT) + CWMIN=SUB(L)*CONTMN(L-1,K)+1.E+6*(1.-SUB(L)) + CEMIN=SUB(L+1)*CONTMN(L+1,K)+1.E+6*(1.-SUB(L+1)) + CSMIN=SVB(L)*CONTMN(LS,K)+1.E+6*(1.-SVB(L)) + CNMIN=SVB(LN)*CONTMN(LN,K)+1.E+6*(1.-SVB(LN)) + CMINT=MIN(CNMIN,CEMIN) + CMINT=MIN(CMINT,CSMIN) + CMINT=MIN(CMINT,CWMIN) + CMIN(L,K)=MIN(CMIN(L,K),CMINT) + ENDDO + ENDDO + MPI_WTIMES(677)=MPI_WTIMES(677)+MPI_TOC(S3TIME) +C +C ** SEPARATE POSITIVE AND NEGATIVE FLUXES PUTTING NEGATIVE FLUXES +C ** INTO FUHV, FVHV, AND FWV +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FUHV(L,K)=MIN(FUHU(L,K),0.) + FUHU(L,K)=MAX(FUHU(L,K),0.) + FVHV(L,K)=MIN(FVHU(L,K),0.) + FVHU(L,K)=MAX(FVHU(L,K),0.) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWV(L,K)=MIN(FWU(L,K),0.) + FWU(L,K)=MAX(FWU(L,K),0.) + ENDDO + ENDDO + CALL broadcast_boundary_array(FUHV,ic) + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHV,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FWV, ic) + CALL broadcast_boundary_array(FWU, ic) + MPI_WTIMES(678)=MPI_WTIMES(678)+MPI_TOC(S3TIME) +C +C ** CALCULATE INFLUX AND OUTFLUX IN CONCENTRATION UNITS AND LOAD +C ** INTO DU AND DV, THEN ADJUCT VALUES AT BOUNDARIES +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + LN=LNC(L) + DU(L,K)=DELT*(DXYIP(L)*(FUHU(L,K)-FUHV(L+1,K) + & +FVHU(L,K)-FVHV(LN,K)) + & +RDZIC*(FWU(L,K-1)-FWV(L,K)) )*HPI(L) + DV(L,K)=DELT*(DXYIP(L)*(FUHU(L+1,K)-FUHV(L,K) + & +FVHU(LN,K)-FVHV(L,K)) + & +RDZIC*(FWU(L,K)-FWV(L,K-1)) )*HPI(L) + ENDDO + ENDDO + DO K=1,KC + DO IOBC=1,NBCSOP + L=LOBCS(IOBC) + DU(L,K)=0. + DV(L,K)=0. + ENDDO + END DO + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + DU(LN,K)=0. + DV(LN,K)=0. + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + DU(L+1,K)=0. + DV(L+1,K)=0. + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + DU(L-1,K)=0. + DV(L-1,K)=0. + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + LS=LSC(L) + DU(LS,K)=0. + DV(LS,K)=0. + ENDDO + ENDDO + MPI_WTIMES(679)=MPI_WTIMES(679)+MPI_TOC(S3TIME) +C +C ** CALCULATE BETA COEFFICIENTS WITH BETAUP AND BETADOWN IN DU AND DV +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(DU(L,K).GT.0.)DU(L,K)=(CMAX(L,K)-POS(L,K))/(DU(L,K)+BSMALL) + DU(L,K)=MIN(DU(L,K),1.) + IF(DV(L,K).GT.0.)DV(L,K)=(CON(L,K)-CMIN(L,K))/(DV(L,K)+BSMALL) + DV(L,K)=MIN(DV(L,K),1.) + ENDDO + ENDDO + MPI_WTIMES(680)=MPI_WTIMES(680)+MPI_TOC(S3TIME) +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(DU,ic) + CALL broadcast_boundary_array(DV,ic) + MPI_WTIMES(699)=MPI_WTIMES(699)+MPI_TOC(S3TIME) +C +C ** LIMIT FLUXES +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + LS=LSC(L) + FUHU(L,K)=MIN(DV(L-1,K),DU(L,K))*FUHU(L,K) + & +MIN(DU(L-1,K),DV(L,K))*FUHV(L,K) + FVHU(L,K)=MIN(DV(LS,K),DU(L,K))*FVHU(L,K) + & +MIN(DU(LS,K),DV(L,K))*FVHV(L,K) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + FWU(L,K)=MIN(DV(L,K),DU(L,K+1))*FWU(L,K) + & +MIN(DU(L,K),DV(L,K+1))*FWV(L,K) + ENDDO + ENDDO + MPI_WTIMES(681)=MPI_WTIMES(681)+MPI_TOC(S3TIME) +C +C ** ANTI-DIFFUSIVE ADVECTION CALCULATION +C + 1100 CONTINUE +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + MPI_WTIMES(700)=MPI_WTIMES(700)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.6)then + DO NS=1,NSED; call collect_in_zero_array(SED(:,:,NS)); ENDDO + IF(MYRANK.EQ.0) PRINT*, MO,'b6', sum(abs(dble(SED))) + endif + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(con) + IF(MYRANK.EQ.0) PRINT*, 'cn2','con = ', sum(abs(dble(con))) + endif +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CH(L,K)=CON(L,K)*HP(L) + & +DELT*( (FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + CON(L,K)=SCB(L)*CH(L,K)*HPI(L)+(1.-SCB(L))*CON(L,K) + ENDDO + ENDDO + MPI_WTIMES(682)=MPI_WTIMES(682)+MPI_TOC(S3TIME) +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(con) + IF(MYRANK.EQ.0) PRINT*, 'cn3','con = ', sum(abs(dble(con))) + endif +C + S3TIME=MPI_TIC() + CALL broadcast_boundary_array(CON,ic) + MPI_WTIMES(700)=MPI_WTIMES(700)+MPI_TOC(S3TIME) +C +C ** ADD REMAINING SEDIMENT SETTLING AND FLUX +C + ENDIF +C +C ** ANTI-DIFFUSIVE ADVECTIVE FLUX CALCULATION WITH DRY BYPASS +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '1FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '1FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '1FWU = ', sum(abs(dble(FWU ))) + endif +C + S3TIME=MPI_TIC() + IF(IDRYTBP.GT.0)THEN + ! *** DSLLC BEGIN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + WWW(L,0)=0.0 + WWW(L,KC)=0.0 + ENDDO + DO K=1,KC + UUU(LC,K)=0.0 + VVV(LC,K)=0.0 + UUU(1,K)=0.0 + VVV(1,K)=0.0 + ENDDO + + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + UUU(L,K)=U2(L,K)*(POS(L,K)-POS(L-1,K))*DXIU(L) + VVV(L,K)=V2(L,K)*(POS(L,K)-POS(LS,K))*DYIV(L) + ELSE + UUU(L,K)=0. + VVV(L,K)=0. + ENDIF + ENDDO + ENDDO + + DO K=1,KS + RDZIG=DZIG(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + WWW(L,K)=W2(L,K)*(POS(L,K+1)-POS(L,K))*HPI(L)*RDZIG + ELSE + WWW(L,K)=0.0 + ENDIF + ENDDO + ENDDO +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(UUU) + call collect_in_zero_array(VVV) + call collect_in_zero_array(WWW ) + IF(MYRANK.EQ.0) PRINT*, 'UUU = ', sum(abs(dble(UUU))) + IF(MYRANK.EQ.0) PRINT*, 'VVV = ', sum(abs(dble(VVV))) + IF(MYRANK.EQ.0) PRINT*, 'WWW = ', sum(abs(dble(WWW))) + endif +C + CALL broadcast_boundary_array(UUU,ic) + CALL broadcast_boundary_array(VVV,ic) + CALL broadcast_boundary_array(WWW,ic) +C + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO PRIVATE(LN,LS,LNW,LSE,AUHU,AVHV,UTERM,VTERM,SSCORUE, +!$OMP+ SSCORUW,SSCORVN,SSCORVS,SSCORU,SSCORV,UHU,VHV) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + AUHU=ABS(UHDY2(L,K)) + AVHV=ABS(VHDX2(L,K)) + UTERM=AUHU*(POS(L,K)-POS(L-1,K)) + VTERM=AVHV*(POS(L,K)-POS(LS,K)) + IF(ISADAC(MVAR).GE.2)THEN + SSCORUE=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORUW=DELTA*RDZIC*DXYIP(L-1)*HPI(L-1)*(FQCPAD(L-1,K) + & -QSUMPAD(L-1,K)*CON(L-1,K)) + SSCORVN=DELTA*RDZIC*DXYIP(L )*HPI(L )*(FQCPAD(L ,K) + & -QSUMPAD(L ,K)*CON(L ,K)) + SSCORVS=DELTA*RDZIC*DXYIP(LS )*HPI(LS )*(FQCPAD(LS ,K) + & -QSUMPAD(LS ,K)*CON(LS ,K)) + SSCORU=MAX(UHDY2(L,K),0.0)*SSCORUW+MIN(UHDY2(L,K),0.0) + & *SSCORUE + SSCORV=MAX(VHDX2(L,K),0.0)*SSCORVS+MIN(VHDX2(L,K),0.0) + & *SSCORVN + UTERM=UTERM+SSCORU + VTERM=VTERM+SSCORV + ENDIF + IF(UHDY2(L,K).GE.0.0)THEN + UTERM=UTERM-0.5*DELTA*UHDY2(L,K)* + & (VVV(LNW,K)+VVV(L-1,K)+WWW(L-1,K)+WWW(L-1,K-1) + & +UUU(L,K)+UUU(L-1,K)) + ELSE + UTERM=UTERM-0.5*DELTA*UHDY2(L,K)* + & (VVV(LN,K)+VVV(L,K)+WWW(L,K)+WWW(L,K-1) + & +UUU(L,K)+UUU(L+1,K)) + ENDIF + IF(VHDX2(L,K).GE.0.0)THEN + VTERM=VTERM-0.5*DELTA*VHDX2(L,K)* + & (UUU(LS,K)+UUU(LSE,K)+WWW(LS,K)+WWW(LS,K-1) + & +VVV(LS,K)+VVV(L,K)) + ELSE + VTERM=VTERM-0.5*DELTA*VHDX2(L,K)* + & (UUU(L,K)+UUU(L+1,K)+WWW(L,K)+WWW(L,K-1) + & +VVV(LN,K)+VVV(L,K)) + ENDIF + IF(ISFCT(MVAR).GE.2)THEN + FUHU(L,K)=0.5*UTERM + FVHU(L,K)=0.5*VTERM + IF(ISFCT(MVAR).EQ.3)THEN + FUHU(L,K)=UTERM + FVHU(L,K)=VTERM + ENDIF + ELSE + UHU=UTERM/(POS(L,K)+POS(L-1,K)+BSMALL) + VHV=VTERM/(POS(L,K)+POS(LS,K)+BSMALL) + FUHU(L,K)=MAX(UHU,0.)*POS(L-1,K) + & +MIN(UHU,0.)*POS(L,K) + FVHU(L,K)=MAX(VHV,0.)*POS(LS,K) + & +MIN(VHV,0.)*POS(L,K) + ENDIF + ELSE + FUHU(L,K)=0. + FVHU(L,K)=0. + ENDIF + ENDDO + ENDDO +C + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '2.FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '2.FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '2.FWU = ', sum(abs(dble(FWU ))) + endif +C + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,AWW,WTERM,SSCORWA,SSCORWB,SSCORW,WW) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + AWW=ABS(W2(L,K)) + WTERM=AWW*(POS(L,K+1)-POS(L,K)) + IF(ISADAC(MVAR).GE.2)THEN + SSCORWA=DELTA*DZIG(K+1)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K+1)-QSUMPAD(L,K+1)*CON(L,K+1)) + SSCORWB=DELTA*DZIG(K)*HPI(L)*DXYIP(L) + & *(FQCPAD(L,K )-QSUMPAD(L,K )*CON(L,K )) + SSCORW=MAX(W2(L,K),0.0)*SSCORWB+MIN(W2(L,K),0.0)*SSCORWA + WTERM=WTERM+SSCORW + ENDIF + IF(W2(L,K).GE.0.0)THEN + WTERM=WTERM-0.5*DELTA*W2(L,K)* + & (UUU(L,K)+UUU(L+1,K)+VVV(L,K)+VVV(LN,K) + & +WWW(L,K)+WWW(L,K-1)) + ELSE + WTERM=WTERM-0.5*DELTA*W2(L,K)* + & (UUU(L+1,K+1)+UUU(L,K+1)+VVV(LN,K+1)+VVV(L,K+1) + & +WWW(L,K)+WWW(L,K+1)) + ENDIF + IF(ISFCT(MVAR).GE.2)THEN + FWU(L,K)=0.5*WTERM + IF(ISFCT(MVAR).EQ.3)THEN + FWU(L,K)=WTERM + ENDIF + ELSE + WW=WTERM/(POS(L,K+1)+POS(L,K)+BSMALL) + FWU(L,K)=MAX(WW,0.)*POS(L,K) + & +MIN(WW,0.)*POS(L,K+1) + ENDIF + ELSE + FWU(L,K)=0. + ENDIF + ENDDO + + ENDDO +C +C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR SOURCE CELLS +C + IF(ISADAC(MVAR).EQ.1)THEN + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + IF(ABS(QSUM(L,K)).GT.1.E-12)THEN + LN=LNC(L) + FUHU(L ,K)=0. + FUHU(L+1,K)=0. + FVHU(L ,K)=0. + FVHU(LN ,K)=0. + FWU(L,K )=0. + FWU(L,K-1)=0. + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(683)=MPI_WTIMES(683)+MPI_TOC(S3TIME) + if(PRINT_SUM.AND.MVAR.eq.2)then + call collect_in_zero_array(FUHU) + call collect_in_zero_array(FVHU) + call collect_in_zero_array(FWU ) + IF(MYRANK.EQ.0) PRINT*, '2FUHU = ', sum(abs(dble(FUHU))) + IF(MYRANK.EQ.0) PRINT*, '2FVHU = ', sum(abs(dble(FVHU))) + IF(MYRANK.EQ.0) PRINT*, '2FWU = ', sum(abs(dble(FWU ))) + endif +C +C ** SET ANTIDIFFUSIVE FLUXES TO ZERO FOR OPEN BOUNDARY CELLS +C + S3TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + FVHU(LN,K)=0.0 + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + FUHU(L+1,K)=0.0 + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + FUHU(L,K)=0.0 + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + FVHU(L,K)=0.0 + ENDDO + ENDDO + MPI_WTIMES(684)=MPI_WTIMES(684)+MPI_TOC(S3TIME) +C +C ** CALCULATE AND APPLY FLUX CORRECTED TRANSPORT LIMITERS +C + IF(ISFCT(MVAR).EQ.0) GOTO 1101 +C +C ** DETERMINE MAX AND MIN CONCENTRATIONS +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CMIN(L,K)=0. + CMAX(L,K)=0. + ENDDO + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CONTMX(L,K)=MAX(CON(L,K),CON2(L,K)) + CONTMN(L,K)=MIN(CON(L,K),CON2(L,K)) + ENDIF + ENDDO + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CMAX(L,1)=MAX(CONTMX(L,1),CONTMX(L,2)) + CMAX(L,KC)=MAX(CONTMX(L,KS),CONTMX(L,KC)) + CMIN(L,1)=MIN(CONTMN(L,1),CONTMN(L,2)) + CMIN(L,KC)=MIN(CONTMN(L,KS),CONTMN(L,KC)) + ENDIF + ENDDO + DO K=2,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CMAXT=MAX(CONTMX(L,K-1),CONTMX(L,K+1)) + CMAX(L,K)=MAX(CONTMX(L,K),CMAXT) + CMINT=MIN(CONTMN(L,K-1),CONTMN(L,K+1)) + CMIN(L,K)=MIN(CONTMN(L,K),CMINT) + ENDIF + ENDDO + ENDDO + CALL broadcast_boundary_array(CONTMN,ic) + CALL broadcast_boundary_array(CONTMX,ic) + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS,LN,CWMAX,CEMAX,CSMAX,CNMAX,CMAXT, +!$OMP+ CWMIN,CEMIN,CSMIN,CNMIN,CMINT) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + LN=LNC(L) + CWMAX=SUB(L)*CONTMX(L-1,K) + CEMAX=SUB(L+1)*CONTMX(L+1,K) + CSMAX=SVB(L)*CONTMX(LS,K) + CNMAX=SVB(LN)*CONTMX(LN,K) + CMAXT=MAX(CNMAX,CEMAX) + CMAXT=MAX(CMAXT,CSMAX) + CMAXT=MAX(CMAXT,CWMAX) + CMAX(L,K)=MAX(CMAX(L,K),CMAXT) + CWMIN=SUB(L)*CONTMN(L-1,K)+1.E+6*(1.-SUB(L)) + CEMIN=SUB(L+1)*CONTMN(L+1,K)+1.E+6*(1.-SUB(L+1)) + CSMIN=SVB(L)*CONTMN(LS,K)+1.E+6*(1.-SVB(L)) + CNMIN=SVB(LN)*CONTMN(LN,K)+1.E+6*(1.-SVB(LN)) + CMINT=MIN(CNMIN,CEMIN) + CMINT=MIN(CMINT,CSMIN) + CMINT=MIN(CMINT,CWMIN) + CMIN(L,K)=MIN(CMIN(L,K),CMINT) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(685)=MPI_WTIMES(685)+MPI_TOC(S3TIME) +C +C ** SEPARATE POSITIVE AND NEGATIVE FLUXES PUTTING NEGATIVE FLUXES +C ** INTO FUHV, FVHV, AND FWV +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FUHV(L,K)=MIN(FUHU(L,K),0.) + FUHU(L,K)=MAX(FUHU(L,K),0.) + FVHV(L,K)=MIN(FVHU(L,K),0.) + FVHU(L,K)=MAX(FVHU(L,K),0.) + ELSE + FUHV(L,K)=0. + FVHV(L,K)=0. + ENDIF + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FWV(L,K)=MIN(FWU(L,K),0.) + FWU(L,K)=MAX(FWU(L,K),0.) + ELSE + FWV(L,K)=0. + ENDIF + ENDDO + ENDDO + MPI_WTIMES(686)=MPI_WTIMES(686)+MPI_TOC(S3TIME) + CALL broadcast_boundary_array(FUHV,ic) + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + CALL broadcast_boundary_array(FVHV,ic) +C +C ** CALCULATE INFLUX AND OUTFLUX IN CONCENTRATION UNITS AND LOAD +C ** INTO DU AND DV, THEN ADJUCT VALUES AT BOUNDARIES +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO PRIVATE(LN) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LN=LNC(L) + DU(L,K)=DELT*SCB(L)*( DXYIP(L)*(FUHU(L,K)-FUHV(L+1,K) + & +FVHU(L,K)-FVHV(LN,K)) + & +RDZIC*(FWU(L,K-1)-FWV(L,K)) )*HPI(L) + DV(L,K)=DELT*SCB(L)*( DXYIP(L)*(FUHU(L+1,K)-FUHV(L,K) + & +FVHU(LN,K)-FVHV(L,K)) + & +RDZIC*(FWU(L,K)-FWV(L,K-1)) )*HPI(L) + ELSE + DU(L,K)=0. + DV(L,K)=0. + ENDIF + ENDDO + ENDDO + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + DU(LN,K)=0. + DV(LN,K)=0. + ENDDO + DO LL=1,NCBW + L=LCBW(LL) + DU(L+1,K)=0. + DV(L+1,K)=0. + ENDDO + DO LL=1,NCBE + L=LCBE(LL) + DU(L-1,K)=0. + DV(L-1,K)=0. + ENDDO + DO LL=1,NCBN + L=LCBN(LL) + LS=LSC(L) + DU(LS,K)=0. + DV(LS,K)=0. + ENDDO + ENDDO + MPI_WTIMES(687)=MPI_WTIMES(687)+MPI_TOC(S3TIME) +C +C ** CALCULATE BETA COEFFICIENTS WITH BETAUP AND BETADOWN IN DU AND DV +C + S3TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + IF(DU(L,K).GT.0.)DU(L,K)=(CMAX(L,K)-POS(L,K))/(DU(L,K) + & +BSMALL) + DU(L,K)=MIN(DU(L,K),1.) + IF(DV(L,K).GT.0.)DV(L,K)=(CON(L,K)-CMIN(L,K))/(DV(L,K) + & +BSMALL) + DV(L,K)=MIN(DV(L,K),1.) + ENDIF + ENDDO + ENDDO + CALL broadcast_boundary_array(DU,ic) + CALL broadcast_boundary_array(DV,ic) +C +C ** LIMIT FLUXES +C + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(LS) + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + LS=LSC(L) + FUHU(L,K)=MIN(DV(L-1,K),DU(L,K))*FUHU(L,K) + & +MIN(DU(L-1,K),DV(L,K))*FUHV(L,K) + FVHU(L,K)=MIN(DV(LS,K),DU(L,K))*FVHU(L,K) + & +MIN(DU(LS,K),DV(L,K))*FVHV(L,K) + ENDIF + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + FWU(L,K)=MIN(DV(L,K),DU(L,K+1))*FWU(L,K) + & +MIN(DU(L,K),DV(L,K+1))*FWV(L,K) + ENDIF + ENDDO + ENDDO + CALL broadcast_boundary_array(FUHU,ic) + CALL broadcast_boundary_array(FVHU,ic) + MPI_WTIMES(688)=MPI_WTIMES(688)+MPI_TOC(S3TIME) +C +C ** END OF ANTI-DIFFUSIVE ADVECTION CALCULATION +C + 1101 CONTINUE +C + S3TIME=MPI_TIC() + DO K=1,KC + RDZIC=DZIC(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(LMASKDRY(L))THEN + CH(L,K)=CON(L,K)*HP(L) + & +DELT*( (FUHU(L,K)-FUHU(L+1,K) + & +FVHU(L,K)-FVHU(LNC(L),K))*DXYIP(L) + & +(FWU(L,K-1)-FWU(L,K))*RDZIC ) + CON(L,K)=SCB(L)*CH(L,K)*HPI(L)+(1.-SCB(L))*CON(L,K) + ENDIF + ENDDO + ENDDO + MPI_WTIMES(689)=MPI_WTIMES(689)+MPI_TOC(S3TIME) +C +C ** ADD REMAINING SEDIMENT SETTLING AND FLUX +C + ENDIF +C +C ** DIAGNOSE FCT SCHEME +C + S3TIME=MPI_TIC() + IF(ISFCT(MVAR).EQ.99)THEN + WRITE(6,6110)N + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(CCMAX,CCMIN) + DO L=LMPI2,LMPILA + CCMAX=SCB(L)*(CON(L,K)-CMAX(L,K)) + IF(CCMAX.GT.0.)THEN + WRITE(6,6111)CON(L,K),CMAX(L,K),IL(L),JL(L),K + ENDIF + CCMIN=SCB(L)*(CMIN(L,K)-CON(L,K)) + IF(CCMIN.GT.0.)THEN + WRITE(6,6112)CMIN(L,K),CON(L,K),IL(L),JL(L),K + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(690)=MPI_WTIMES(690)+MPI_TOC(S3TIME) + 6110 FORMAT(' FCT DIAGNOSTICS AT N = ',I5) + 6111 FORMAT(' CON = ',E12.4,3X,'CMAX = ',E12.4,3X,'I,J,K=',(3I10)) + 6112 FORMAT(' CMIN = ',E12.4,3X,'CON = ',E12.4,3X,'I,J,K=',(3I10)) + + ! *** ZERO HEAT FLUXES + 2000 IF(MVAR.EQ.2)THEN + ! *** ZERO EVAP/RAINFALL + S3TIME=MPI_TIC() + !$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FQC(L,KC)=0. + ENDDO + IF(ISADAC(MVAR).GE.2)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + FQCPAD(L,KC)=0. + ENDDO + ENDIF + IF(ISADAC(MVAR).GT.0)THEN +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + QSUMPAD(L,KC)=0. + ENDDO + ENDIF + MPI_WTIMES(691)=MPI_WTIMES(691)+MPI_TOC(S3TIME) + ENDIF + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY_mpi.for new file mode 100644 index 000000000..a2b89b00e --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTSXY_mpi.for @@ -0,0 +1,455 @@ + SUBROUTINE CALTSXY_mpi +C +C CHANGE RECORD +C ** SUBROUTINE CALTSXY UPDATES TIME VARIABLE SURFACE WIND STRESS +C + USE GLOBAL + USE MPI +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CLOUDTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EVAPTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PATMTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RAINTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::RHAT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SOLSWRTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVPAT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TATMTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TWETTT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::VPAT +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDE +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDN +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXX +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSXY +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYX +c REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WINDSYY + IF(.NOT.ALLOCATED(CLOUDTT))THEN + ALLOCATE(CLOUDTT(NASERM)) + ALLOCATE(EVAPTT(NASERM)) + ALLOCATE(PATMTT(NASERM)) + ALLOCATE(RAINTT(NASERM)) + ALLOCATE(RHAT(NASERM)) + ALLOCATE(SOLSWRTT(NASERM)) + ALLOCATE(SVPAT(NASERM)) + ALLOCATE(TATMTT(NASERM)) + ALLOCATE(TWETTT(NASERM)) + ALLOCATE(VPAT(NASERM)) + ALLOCATE(WINDE(NWSERM)) + ALLOCATE(WINDN(NWSERM)) + ALLOCATE(WINDSXX(LCM)) + ALLOCATE(WINDSXY(LCM)) + ALLOCATE(WINDSYX(LCM)) + ALLOCATE(WINDSYY(LCM)) + + CLOUDTT=0.0 + EVAPTT=0.0 + PATMTT=0.0 + RAINTT=0.0 + RHAT=0.0 + SOLSWRTT=0.0 + SVPAT=0.0 + TATMTT=0.0 + TWETTT=0.0 + VPAT=0.0 + WINDE=0.0 + WINDN=0.0 + WINDSXX=0.0 + WINDSXY=0.0 + WINDSYX=0.0 + WINDSYY=0.0 + + ! *** ONE TIME SPATIAL DISTRIBUTION,\ +C *** OOPS, REVC & RCHC NOT SAVED FOR EACH SERIES +C DO L=2,LA +C CLEVAP(L)=0. +C CCNHTT(L)=0. +C ENDDO +C DO NA=1,NASER +C CLEVAPT=0.001*ABS(REVC) +C CCNHTTT=0.001*ABS(RCHC) +C DO L=2,LA +C CLEVAP(L)=CLEVAP(L)+ATMWHT(L,NA)*CLEVAPT +C CCNHTT(L)=CCNHTT(L)+ATMWHT(L,NA)*CCNHTTT +C ENDDO +C ENDDO + DO L=2,LA + CLEVAP(L)=0.001*ABS(REVC) + CCNHTT(L)=0.001*ABS(RCHC) + ENDDO + ENDIF +C +C**********************************************************************C +C +C INITIALIZE WIND SHELTERED SURFACE GAS TRANSFER +C + S1TIME=MPI_TIC() + IF(N.EQ.-1.AND.NWSER.GT.0)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='WINDSHELT.OUT') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='WINDSHELT.OUT') + ENDIF +!$OMP PARALLEL DO PRIVATE(I,J,LS,LN) + DO L=LMPI2,LMPILA + I=IL(L) + J=JL(L) + IF(WINDSTKA(L).GT.0.0)THEN + ! ** IF WINDSTKA > 0 BOTH X AND Y COMPONENTS ARE APPLIED + WINDSXX(L)=CVN(L) + WINDSXY(L)=-CVE(L) + WINDSYX(L)=-CUN(L) + WINDSYY(L)=CUE(L) + ELSE + ! ** IF WINDSTKA < 0 SLECTIVELY APPLY X AND Y COMPONENTS + ! ** FIRST CASE IS FULLY OPEN WATER + WINDSXX(L)=CVN(L) + WINDSXY(L)=-CVE(L) + WINDSYX(L)=-CUN(L) + WINDSYY(L)=CUE(L) + LS=LSC(L) + LN=LNC(L) + ! ** SECOND CASE IS 1D CHANNEL IN COMP X DIRECTION + IF(SVB(L).LT.0.5.AND.IJCT(I,J-1).NE.5)THEN + IF(SVB(LN).LT.0.5.AND.IJCT(I,J+1).NE.5)THEN + WINDSXX(L)=CVN(L) + WINDSXY(L)=-CVE(L) + WINDSYX(L)=-1000. + WINDSYY(L)=0. + ENDIF + ENDIF + ! ** THIRD CASE IS 1D CHANNEL IN COMP Y DIRECTION + IF(SUB(L).LT.0.5.AND.IJCT(I-1,J).NE.5)THEN + IF(SUB(L+1).LT.0.5.AND.IJCT(I+1,J).NE.5)THEN + WINDSXX(L)=0. + WINDSXY(L)=-1000. + WINDSYX(L)=-CUN(L) + WINDSYY(L)=CUE(L) + ENDIF + ENDIF + ENDIF + IF(DEBUG.AND.MYRANK.EQ.0) WRITE(1,1111)IL(L),JL(L),WINDSTKA(L) + & ,WINDSXX(L),WINDSXY(L),WINDSYX(L),WINDSYY(L) + ENDDO + IF(DEBUG.AND.MYRANK.EQ.0) CLOSE(1) + ENDIF + 1111 FORMAT(2I5,10F10.6) + MPI_WTIMES(871)=MPI_WTIMES(871)+MPI_TOC(S1TIME) +C +C**********************************************************************C +C + IF(NWSER.GT.0)THEN + S1TIME=MPI_TIC() + ! *** UPDATE THE FORCING WIND DATA TO THE CURRENT TIME + DO NA=1,NWSER + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)/TCWSER(NA)+TBEGIN*(TCON/TCWSER(NA)) + ELSE + TIME=TIMESEC/TCWSER(NA) + ENDIF + M1=MWTLAST(NA) + MSAVE=M1 + 200 CONTINUE + M2=M1+1 + IF(TIME.GT.TWSER(M2,NA))THEN + M1=M2 + GOTO 200 + ELSE + MWTLAST(NA)=M1 + ENDIF + TDIFF=TWSER(M2,NA)-TWSER(M1,NA) + WTM1=(TWSER(M2,NA)-TIME)/TDIFF + WTM2=(TIME-TWSER(M1,NA))/TDIFF + DEGM1=90.-WINDD(M1,NA) + DEGM2=90.-WINDD(M2,NA) + WINDS1=WTM1*WINDS(M1,NA)+WTM2*WINDS(M2,NA) + WINDS2=WTM1*WINDS(M1,NA)+WTM2*WINDS(M2,NA) + WINDE1=WINDS(M1,NA)*COS(DEGM1/57.29578) + WINDN1=WINDS(M1,NA)*SIN(DEGM1/57.29578) + WINDE2=WINDS(M2,NA)*COS(DEGM2/57.29578) + WINDN2=WINDS(M2,NA)*SIN(DEGM2/57.29578) + WINDE(NA)=WTM1*WINDE1+WTM2*WINDE2 + WINDN(NA)=WTM1*WINDN1+WTM2*WINDN2 + ENDDO + MPI_WTIMES(872)=MPI_WTIMES(872)+MPI_TOC(S1TIME) + + ! *** CALCULATE THE WIND STRESS + S1TIME=MPI_TIC() + IF(NWSER.GT.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WNDVELE(L)=0. + WNDVELN(L)=0. + ENDDO + DO NA=1,NWSER +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WNDVELE(L)=WNDVELE(L)+WNDWHT(L,NA)*WINDE(NA) + WNDVELN(L)=WNDVELN(L)+WNDWHT(L,NA)*WINDN(NA) + ENDDO + ENDDO + ELSE !IF(NWSER.EQ.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WNDVELE(L)=WINDE(1) + WNDVELN(L)=WINDN(1) + ENDDO + ENDIF + MPI_WTIMES(873)=MPI_WTIMES(873)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(WNDFAC,C2,CD10,TSEAST,TSNORT,WINDXX,WINDYY) + DO L=LMPI2,LMPILA + ! ** CASE 0 MAGNITUDE SHELTERING AND NO DIRECTIONAL SHELTERING + IF(WINDSTKA(L).GT.0.0)THEN + WNDFAC=ABS(WINDSTKA(L)) + WNDVELE(L)=WNDFAC*WNDVELE(L) + WNDVELN(L)=WNDFAC*WNDVELN(L) + WINDST(L)=SQRT( WNDVELE(L)*WNDVELE(L) + & +WNDVELN(L)*WNDVELN(L) ) +!{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. +! C2=1.2E-6*(0.8+0.065*WINDST(L)) + IF(ISCD.EQ.1)THEN + C2=1.2E-6*(0.26+0.46*WINDST(L)/CDDN(L)) ! Dean(1997) + ELSEIF(ISCD.EQ.2)THEN + IF(WINDST(L).NE.0.0)THEN + IF(WINDST(L).GE.WNDCR)THEN + CD10=(WNDCM*WINDST(L)+WNDB)**2/WINDST(L)**2 ! Foreman(2012) + ELSE + CD10=(WNDCM*WNDCR+WNDB)**2/WNDCR**2 ! Foreman(2012) + ENDIF + C2=1.2E-3*CD10 ! Foreman(2012) + ELSE + C2=0.0 + ENDIF + ELSE + C2=1.2E-6*(WNDCM+WNDB*WINDST(L)) + ENDIF +!} GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. + TSEAST=C2*WINDST(L)*WNDVELE(L) + TSNORT=C2*WINDST(L)*WNDVELN(L) + TSX(L)=WINDSXX(L)*TSEAST+WINDSXY(L)*TSNORT + TSY(L)=WINDSYX(L)*TSEAST+WINDSYY(L)*TSNORT + + ELSEIF(WINDSTKA(L).LT.0.0)THEN + ! ** CASE 1 MAGNITUDE SHELTERING AND DIRECTIONAL SHELTERING, OPEN WATER + IF(WINDSYX(L).GT.-99.0.AND.WINDSXY(L).GT.-99.0)THEN + WNDFAC=ABS(WINDSTKA(L)) + WNDVELE(L)=WNDFAC*WNDVELE(L) + WNDVELN(L)=WNDFAC*WNDVELN(L) + WINDST(L)=SQRT( WNDVELE(L)*WNDVELE(L) + & +WNDVELN(L)*WNDVELN(L) ) +!{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. +! C2=1.2E-6*(0.8+0.065*WINDST(L)) + IF(ISCD.EQ.1)THEN + C2=1.2E-6*(0.26+0.46*WINDST(L)/CDDN(L)) ! Dean(1997) + ELSEIF(ISCD.EQ.2)THEN + IF(WINDST(L).NE.0.0)THEN + IF(WINDST(L).GE.WNDCR)THEN + CD10=(WNDCM*WINDST(L)+WNDB)**2/WINDST(L)**2 ! Foreman(2012) + ELSE + CD10=(WNDCM*WNDCR+WNDB)**2/WNDCR**2 ! Foreman(2012) + ENDIF + C2=1.2E-3*CD10 !Foreman(2012) + ELSE + C2=0.0 + ENDIF + ELSE + C2=1.2E-6*(WNDCM+WNDB*WINDST(L)) + ENDIF +!} GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. + TSEAST=C2*WINDST(L)*WNDVELE(L) + TSNORT=C2*WINDST(L)*WNDVELN(L) + TSX(L)=WINDSXX(L)*TSEAST+WINDSXY(L)*TSNORT + TSY(L)=WINDSYX(L)*TSEAST+WINDSYY(L)*TSNORT + ENDIF + + ! ** CASE 2 MAGNITUDE SHELTERING AND DIRECTIONAL SHELTERING, X CHANNEL + IF(WINDSYX(L).LT.-99.0)THEN + WINDXX=WINDSXX(L)*WNDVELE(L)+WINDSXY(L)*WNDVELN(L) + WNDFAC=ABS(WINDSTKA(L)) + WINDXX=WNDFAC*WNDVELE(L) + WINDST(L)=ABS(WINDXX) +!{GeoSR, YSSONG, ICE COVER, 1111031 + IF(PSHADE(L).NE.1.0) WINDST(L)=0.0 +!} +!{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. +! TSX(L)=1.2E-6*(0.8+0.065*WINDST(L))*WINDST(L)*WINDXX + IF(ISCD.EQ.1)THEN + TSX(L)=1.2E-6*(0.26+0.46*WINDST(L)/CDDN(L)) ! Dean(1997) + & *WINDST(L)*WINDXX + ELSEIF(ISCD.EQ.2)THEN + IF(WINDST(L).NE.0.0)THEN + IF(WINDST(L).GE.WNDCR)THEN + CD10=(WNDCM*WINDST(L)+WNDB)**2/WINDST(L)**2 ! Foreman(2012) + ELSE + CD10=(WNDCM*WNDCR+WNDB)**2/WNDCR**2 ! Foreman(2012) + ENDIF + TSX(L)=1.2E-3*CD10*WINDST(L)*WINDXX ! Foreman(2012) + ELSE + TSX(L)=0.0 + ENDIF + ELSE + TSX(L)=1.2E-6*(WNDCM+WNDB*WINDST(L))*WINDST(L)*WINDXX + ENDIF +!} GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. + TSY(L)=0. + ENDIF + + ! ** CASE 3 MAGNITUDE SHELTERING AND DIRECTIONAL SHELTERING, Y CHANNEL + IF(WINDSXY(L).LT.-99.0)THEN + WINDYY=WINDSYX(L)*WNDVELE(L)+WINDSYY(L)*WNDVELN(L) + WNDFAC=ABS(WINDSTKA(L)) + WINDYY=WNDFAC*WINDYY + WINDST(L)=ABS(WINDYY) + TSX(L)=0 +!{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. +! TSY(L)=1.2E-6*(0.8+0.065*WINDST(L))*WINDST(L)*WINDYY + IF(ISCD.EQ.1)THEN + TSY(L)=1.2E-6*(0.26+0.46*WINDST(L)/CDDN(L)) ! Dean(1997) + & *WINDST(L)*WINDYY + ELSEIF(ISCD.EQ.2)THEN + IF(WINDST(L).NE.0.0)THEN + IF(WINDST(L).GE.WNDCR)THEN + CD10=(WNDCM*WINDST(L)+WNDB)**2/WINDST(L)**2 ! Foreman(2012) + ELSE + CD10=(WNDCM*WNDCR+WNDB)**2/WNDCR**2 ! Foreman(2012) + ENDIF + TSY(L)=1.2E-3*CD10*WINDST(L)*WINDYY ! Foreman(2012) + ELSE + TSX(L)=0.0 + ENDIF + ELSE + TSY(L)=1.2E-6*(WNDCM+WNDB*WINDST(L))*WINDST(L)*WINDYY + ENDIF +!} GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. + ENDIF + ENDIF + ENDDO + MPI_WTIMES(874)=MPI_WTIMES(874)+MPI_TOC(S1TIME) + ENDIF +C +C CFTSX=1. +C CFTSY=1. +C HHUU=2.*HUWET(L) +C HHVV=2.*HVWET(L) +C + IF(NASER.GT.0)THEN + S1TIME=MPI_TIC() + DO NA=1,NASER + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)/TCASER(NA)+TBEGIN*(TCON/TCASER(NA)) + ELSE + TIME=TIMESEC/TCASER(NA) + ENDIF + M1=MATLAST(NA) + 100 CONTINUE + M2=M1+1 + IF(TIME.GT.TASER(M2,NA))THEN + M1=M2 + GOTO 100 + ELSE + MATLAST(NA)=M1 + ENDIF + TDIFF=TASER(M2,NA)-TASER(M1,NA) + WTM1=(TASER(M2,NA)-TIME)/TDIFF + WTM2=(TIME-TASER(M1,NA))/TDIFF + PATMTT(NA)=WTM1*PATM(M1,NA)+WTM2*PATM(M2,NA) + TATMTT(NA)=WTM1*TDRY(M1,NA)+WTM2*TDRY(M2,NA) + TWETTT(NA)=WTM1*TWET(M1,NA)+WTM2*TWET(M2,NA) + RAINTT(NA)=WTM1*RAIN(M1,NA)+WTM2*RAIN(M2,NA) + EVAPTT(NA)=WTM1*EVAP(M1,NA)+WTM2*EVAP(M2,NA) + SOLSWRTT(NA)=WTM1*SOLSWR(M1,NA)+WTM2*SOLSWR(M2,NA) + CLOUDTT(NA)=WTM1*CLOUD(M1,NA)+WTM2*CLOUD(M2,NA) + SVPAT(NA)= + & 10.**((0.7859+0.03477*TATMTT(NA))/(1.+0.00412*TATMTT(NA))) + IF(IRELH(NA).EQ.0.AND.ISTOPT(2).NE.4)THEN +C RHAT(NA)=1. +C & -0.00066*(PATMTT(NA)/SVPAT(NA))*(TATMTT(NA)-TWETTT(NA)) + ! *** DSLLC Begin + ! *** (Correct RHA Computation from wet bulb) + TMPVAL=0.00066*(1.0+0.00115*TWETTT(NA)) + SVPWET= + & 10.**((0.7859+0.03477*TWETTT(NA))/(1.+0.00412*TWETTT(NA))) + TMPVL1=SVPWET-TMPVAL*PATMTT(NA)*(TATMTT(NA)-TWETTT(NA)) + RHAT(NA)=MAX(TMPVL1/ SVPAT(NA),.01) + ! *** DSLLC End + ELSE + RHAT(NA)=TWETTT(NA) + ENDIF + VPAT(NA)=RHAT(NA)*SVPAT(NA) + ENDDO + MPI_WTIMES(875)=MPI_WTIMES(875)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + IF(NASER.GT.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PATMT(L)=0. + TATMT(L)=0. + RAINT(L)=0. + EVAPT(L)=0. + SOLSWRT(L)=0. + CLOUDT(L)=0. + SVPA(L)=0. + RHA(L)=0. + VPA(L)=0. + ENDDO + DO NA=1,NASER +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PATMT(L)=PATMT(L)+ATMWHT(L,NA)*PATMTT(NA) + TATMT(L)=TATMT(L)+ATMWHT(L,NA)*TATMTT(NA) + RAINT(L)=RAINT(L)+ATMWHT(L,NA)*RAINTT(NA) + EVAPT(L)=EVAPT(L)+ATMWHT(L,NA)*EVAPTT(NA) + SOLSWRT(L)=SOLSWRT(L)+ATMWHT(L,NA)*SOLSWRTT(NA) + CLOUDT(L)=CLOUDT(L)+ATMWHT(L,NA)*CLOUDTT(NA) + SVPA(L)=SVPA(L)+ATMWHT(L,NA)*SVPAT(NA) + RHA(L)=RHA(L)+ATMWHT(L,NA)*RHAT(NA) + VPA(L)=VPA(L)+ATMWHT(L,NA)*VPAT(NA) + ENDDO + ENDDO + ELSE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PATMT(L)=PATMTT(1) + TATMT(L)=TATMTT(1) + RAINT(L)=RAINTT(1) + EVAPT(L)=EVAPTT(1) + SOLSWRT(L)=SOLSWRTT(1) + CLOUDT(L)=CLOUDTT(1) + SVPA(L)=SVPAT(1) + RHA(L)=RHAT(1) + VPA(L)=VPAT(1) + ENDDO + ENDIF + MPI_WTIMES(876)=MPI_WTIMES(876)+MPI_TOC(S1TIME) +C + ! *** PMC - MOVED ALL TIME INVARIANT PARAMETERS TO KEEP FROM COMPUTING EVERY TIME + S1TIME=MPI_TIC() + IF(REVC.LT.0.)THEN + CLEVAPTMP=0.001*ABS(REVC) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CLEVAP(L)=1.E-3*(0.8+0.065*WINDST(L)) + CLEVAP(L)=MAX(CLEVAP(L),CLEVAPTMP) + ENDDO + ENDIF + + IF(RCHC.LT.0.)THEN + CCNHTTTMP=0.001*ABS(RCHC) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + CCNHTT(L)=1.E-3*(0.8+0.065*WINDST(L)) + CCNHTT(L)=MAX(CCNHTT(L),CCNHTTTMP) + ENDDO + ENDIF + MPI_WTIMES(877)=MPI_WTIMES(877)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + CALL broadcast_boundary(TSX,ic) + CALL broadcast_boundary(TSY,ic) + MPI_WTIMES(878)=MPI_WTIMES(878)+MPI_TOC(S1TIME) + + ENDIF +C + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW_mpi.for new file mode 100644 index 000000000..ab1c0d9c7 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALUVW_mpi.for @@ -0,0 +1,791 @@ + SUBROUTINE CALUVW_mpi (ISTL_,IS2TL_) +C +C CHANGE RECORD +C ** CALCULATE THE INTERNAL SOLUTION AT TIME LEVEL (N+1) +C ** THE VALUE OF ISTL INDICATES THE NUMBER OF TIME LEVELS IN THE STEP +C + USE GLOBAL + USE MPI + REAL DTCFL + DTCFL=0.0 +C + IF(ISDYNSTP.EQ.0)THEN + DELT=DT2 + DELTD2=DT + IF(ISTL_.EQ.2)THEN + DELT=DT + DELTD2=0.5*DT + ENDIF + DELTI=1./DELT + ELSE + DELT=DTDYN + DELTD2=0.5*DTDYN + DELTI=1./DELT + ENDIF + IF(KC.EQ.1) GOTO 30 +C +C ** CALCULATE BOTTOM FRICTION COEFFICIENT +C + IF(ISTL_.EQ.3)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=AVCON1/H1U(L)+STBX(L)*SQRT(U1(L,1)*U1(L,1) + & +V1U(L)*V1U(L)) + RCY(L)=AVCON1/H1V(L)+STBY(L)*SQRT(U1V(L)*U1V(L) + & +V1(L,1)*V1(L,1)) + ENDDO + MPI_WTIMES(101)=MPI_WTIMES(101)+MPI_TOC(S1TIME) +C +C LF=2+(ND-1)*LDM +C + ELSE + S1TIME=MPI_TIC() + IF(AVCON1.LT.0.00001)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + ! *** FOR 2TL U1 & U AND V1 & V ARE THE SAME + ! *** THESE ARE ONLY DIFFERENCE FOR 3TL ISTL=2 TRAP CORRECTION STEP + RCX(L)=STBX(L)*SQRT(SQRT(U1(L,1)*U1(L,1)+V1U(L)*V1U(L)) + & *SQRT(U(L,1)*U(L,1)+VU(L)*VU(L))) + RCY(L)=STBY(L)*SQRT(SQRT(U1V(L)*U1V(L)+V1(L,1)*V1(L,1)) + & *SQRT(UV(L)*UV(L)+V(L,1)*V(L,1))) + ENDDO + ELSE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCX(L)=AVCON1/SQRT(H1U(L)*HU(L))+STBX(L) + & *SQRT(SQRT(U1(L,1)*U1(L,1)+V1U(L)*V1U(L)) + & *SQRT(U(L,1)*U(L,1)+VU(L)*VU(L))) + RCY(L)=AVCON1/SQRT(H1V(L)*HV(L))+STBY(L) + & *SQRT(SQRT(U1V(L)*U1V(L)+V1(L,1)*V1(L,1)) + & *SQRT(UV(L)*UV(L)+V(L,1)*V(L,1))) + ENDDO + ENDIF + MPI_WTIMES(102)=MPI_WTIMES(102)+MPI_TOC(S1TIME) +C +C LF=2+(ND-1)*LDM +C + ENDIF +C + if(PRINT_SUM)then + call collect_in_zero(RCX ) + call collect_in_zero(RCY ) + call collect_in_zero(HU ) + call collect_in_zero(HV ) + call collect_in_zero_array(AVUI ) + call collect_in_zero_array(AVVI ) + IF(MYRANK.EQ.0) PRINT*, 'RCX = ', sum(abs(dble(RCX))) + IF(MYRANK.EQ.0) PRINT*, 'RCY = ', sum(abs(dble(RCY))) + IF(MYRANK.EQ.0) PRINT*, 'HU = ', sum(abs(dble(HU))) + IF(MYRANK.EQ.0) PRINT*, 'HV = ', sum(abs(dble(HV))) + IF(MYRANK.EQ.0) PRINT*, 'AVUI = ', sum(abs(dble(AVUI))) + IF(MYRANK.EQ.0) PRINT*, 'AVVI = ', sum(abs(dble(AVVI))) + endif +C ** CALCULATE THE U AND V SHEARS +C + S1TIME=MPI_TIC() + RCDZM=CDZM(1)*DELTI + RCDZU=CDZU(1) + RCDZL=CDZL(1) +!$OMP PARALLEL DO PRIVATE(CMU,CMV,EU,EV) + DO L=LMPI2,LMPILA + CMU=1.+RCDZM*HU(L)*AVUI(L,1) + CMV=1.+RCDZM*HV(L)*AVVI(L,1) + EU=1./CMU + EV=1./CMV + CU1(L,1)=RCDZU*EU + CU2(L,1)=RCDZU*EV + DU(L,1)=(DU(L,1)-RCDZL*RCX(L)*UHE(L)*HUI(L))*EU + DV(L,1)=(DV(L,1)-RCDZL*RCY(L)*VHE(L)*HVI(L))*EV + UUU(L,1)=EU + VVV(L,1)=EV + ENDDO + MPI_WTIMES(103)=MPI_WTIMES(103)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=2,KS + RCDZM=CDZM(K)*DELTI + RCDZU=CDZU(K) + RCDZL=CDZL(K) +!$OMP PARALLEL DO PRIVATE(CMU,CMV,EU,EV) + DO L=LMPI2,LMPILA + CMU=1.+RCDZM*HU(L)*AVUI(L,K) + CMV=1.+RCDZM*HV(L)*AVVI(L,K) + EU=1./(CMU-RCDZL*CU1(L,K-1)) + EV=1./(CMV-RCDZL*CU2(L,K-1)) + CU1(L,K)=RCDZU*EU + CU2(L,K)=RCDZU*EV + DU(L,K)=(DU(L,K)-RCDZL*DU(L,K-1))*EU + DV(L,K)=(DV(L,K)-RCDZL*DV(L,K-1))*EV + UUU(L,K)=-RCDZL*UUU(L,K-1)*EU + VVV(L,K)=-RCDZL*VVV(L,K-1)*EV + ENDDO + ENDDO + MPI_WTIMES(104)=MPI_WTIMES(104)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=KS-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DU(L,K)=DU(L,K)-CU1(L,K)*DU(L,K+1) + DV(L,K)=DV(L,K)-CU2(L,K)*DV(L,K+1) + UUU(L,K)=UUU(L,K)-CU1(L,K)*UUU(L,K+1) + VVV(L,K)=VVV(L,K)-CU2(L,K)*VVV(L,K+1) + ENDDO + ENDDO + MPI_WTIMES(105)=MPI_WTIMES(105)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AAU(L)=0. + AAV(L)=0. + BBU(L)=1. + BBV(L)=1. + ENDDO + MPI_WTIMES(106)=MPI_WTIMES(106)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=1,KS + RCDZR=CDZR(K) +!$OMP PARALLEL DO PRIVATE(CRU,CRV) + DO L=LMPI2,LMPILA + CRU=RCDZR*RCX(L)*AVUI(L,K) + CRV=RCDZR*RCY(L)*AVVI(L,K) + AAU(L)=AAU(L)+CRU*DU(L,K) + AAV(L)=AAV(L)+CRV*DV(L,K) + BBU(L)=BBU(L)+CRU*UUU(L,K) + BBV(L)=BBV(L)+CRV*VVV(L,K) + ENDDO + ENDDO + MPI_WTIMES(107)=MPI_WTIMES(107)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + AAU(L)=AAU(L)/BBU(L) + AAV(L)=AAV(L)/BBV(L) + ENDDO + MPI_WTIMES(108)=MPI_WTIMES(108)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + DO K=1,KS + RDZG=DZG(K) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + DU(L,K)=RDZG*HU(L)*AVUI(L,K)*(DU(L,K)-AAU(L)*UUU(L,K)) + DV(L,K)=RDZG*HV(L)*AVVI(L,K)*(DV(L,K)-AAV(L)*VVV(L,K)) + ENDDO + ENDDO + MPI_WTIMES(109)=MPI_WTIMES(109)+MPI_TOC(S1TIME) +C +C ** CALCULATED U AND V +C ** DUSUM+UHE=UHE, DVSUM+VHE=VHE +C + if(PRINT_SUM)then + call collect_in_zero_array(UHDY ) + call collect_in_zero_array(VHDX ) + call collect_in_zero_array(U ) + call collect_in_zero_array(V ) + call collect_in_zero_array(W ) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_UHDY = ', sum(abs(dble(UHDY))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_VHDX = ', sum(abs(dble(VHDX))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_U = ', sum(abs(dble(U ))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_V = ', sum(abs(dble(V ))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_W = ', sum(abs(dble(W ))) + endif + + if(PRINT_SUM)then + call collect_in_zero_array(DU ) + call collect_in_zero_array(DV ) + call collect_in_zero_array(UUU ) + call collect_in_zero_array(VVV ) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_DU = ', sum(abs(dble(DU))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_DV = ', sum(abs(dble(DV))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_UUU = ', sum(abs(dble(UUU ))) + IF(MYRANK.EQ.0) PRINT*, 'AUVW_VVV = ', sum(abs(dble(VVV ))) + endif + S1TIME=MPI_TIC() + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHE(L)=UHE(L)+CDZD(K)*DU(L,K) + VHE(L)=VHE(L)+CDZD(K)*DV(L,K) + ENDDO + ENDDO + MPI_WTIMES(110)=MPI_WTIMES(110)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY(L,KC)=UHE(L)*SUB(L) + VHDX(L,KC)=VHE(L)*SVB(L) + ENDDO + MPI_WTIMES(111)=MPI_WTIMES(111)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=KS,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY(L,K)=UHDY(L,K+1)-DU(L,K)*SUB(L) + VHDX(L,K)=VHDX(L,K+1)-DV(L,K)*SVB(L) + ENDDO + ENDDO + MPI_WTIMES(112)=MPI_WTIMES(112)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + U(L,K)=UHDY(L,K)*HUI(L) + V(L,K)=VHDX(L,K)*HVI(L) + UHDY(L,K)=UHDY(L,K)*DYU(L) + VHDX(L,K)=VHDX(L,K)*DXV(L) + ENDDO + ENDDO + MPI_WTIMES(113)=MPI_WTIMES(113)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3E(L)=SUM(UHDY(L,1:KC)*DZC(1:KC))-UHDYE(L) + TVAR3N(L)=SUM(VHDX(L,1:KC)*DZC(1:KC))-VHDXE(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY(L,1:KC)=UHDY(L,1:KC)-TVAR3E(L)*DZIC(1:KC) + VHDX(L,1:KC)=VHDX(L,1:KC)-TVAR3N(L)*DZIC(1:KC) + ENDDO + MPI_WTIMES(115)=MPI_WTIMES(115)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() +C +C ** RESET VELOCITIES +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHE(L)=0. + VHE(L)=0. + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHE(L)=UHE(L)+UHDY(L,K)*DZC(K) + VHE(L)=VHE(L)+VHDX(L,K)*DZC(K) + ENDDO + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + U(L,:)=UHDY(L,:)*HUI(L) + V(L,:)=VHDX(L,:)*HVI(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + U(L,:)=U(L,:)*DYIU(L) + V(L,:)=V(L,:)*DXIV(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHE(L)=UHE(L)*DYIU(L) + VHE(L)=VHE(L)*DXIV(L) + ENDDO + MPI_WTIMES(116)=MPI_WTIMES(116)+MPI_TOC(S1TIME) +C +C ** UNCOMMENT BELOW TO WRITE CONTINUITY DIAGNOSITCS +C +C6661 FORMAT(' I,J,UHDYERMX = ',2I5,E14.5) +C6662 FORMAT(' I,J,UHDYERMN = ',2I5,E14.5) +C6663 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) +C6664 FORMAT(' I,J,VHDYERMX = ',2I5,E14.5) +C +C ** CALCULATE W +C + IF(ISTL_.EQ.3)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3E(L)=UHDYE(L+1 ) + TVAR3N(L)=VHDXE(LNC(L)) + TVAR3W(L)=UHDY2E(L+1 ) + TVAR3S(L)=VHDX2E(LNC(L)) + ENDDO + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR1E(L,K)=UHDY(L+1 ,K) + TVAR1N(L,K)=VHDX(LNC(L),K) + TVAR1W(L,K)=UHDY2(L+1 ,K) + TVAR1S(L,K)=VHDX2(LNC(L),K) + ENDDO + ENDDO + DO K=1,KS +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + W(L,K)=W(L,K-1) - 0.5*DZC(K)*DXYIP(L)* + & (TVAR1E(L,K)-UHDY(L,K)-TVAR3E(L)+UHDYE(L) + & +TVAR1W(L,K)-UHDY2(L,K)-TVAR3W(L)+UHDY2E(L) + & +TVAR1N(L,K)-VHDX(L,K)-TVAR3N(L)+VHDXE(L) + & +TVAR1S(L,K)-VHDX2(L,K)-TVAR3S(L)+VHDX2E(L)) + & +(QSUM(L,K)-DZC(K)*QSUME(L))*DXYIP(L) + ENDDO + ENDDO + MPI_WTIMES(117)=MPI_WTIMES(117)+MPI_TOC(S1TIME) + ELSEIF(ISTL_.EQ.2)THEN + S1TIME=MPI_TIC() + call broadcast_boundary_array(UHDY, ic) + call broadcast_boundary_array(UHDY1,ic) + call broadcast_boundary_array(VHDX, ic) + call broadcast_boundary_array(VHDX1,ic) + call broadcast_boundary(UHDYE ,ic) + call broadcast_boundary(UHDY1E,ic) + call broadcast_boundary(VHDXE ,ic) + call broadcast_boundary(VHDX1E,ic) + DO K=1,KS +!$OMP PARALLEL DO PRIVATE(LN,LE) + DO L=LMPI2,LMPILA + LN=LNC(L) + LE=L+1 + W(L,K)=W(L,K-1) - 0.5*DZC(K)*DXYIP(L)* + & ( UHDY(LE,K)- UHDY(L,K)- UHDYE(LE)+UHDYE(L) + & +UHDY1(LE,K)-UHDY1(L,K)-UHDY1E(LE)+UHDY1E(L) + & + VHDX(LN,K)- VHDX(L,K)- VHDXE(LN)+VHDXE(L) + & +VHDX1(LN,K)-VHDX1(L,K)-VHDX1E(LN)+VHDX1E(L)) + & +(QSUM(L,K)-DZC(K)*QSUME(L) )*DXYIP(L) + ENDDO + ENDDO + MPI_WTIMES(118)=MPI_WTIMES(118)+MPI_TOC(S1TIME) + ENDIF +C + ! *** APPLY OPEN BOUNDARYS + S1TIME=MPI_TIC() + DO LL=1,NBCSOP + L=LOBCS(LL) + DO K=1,KS + W(L,K)=0.0 + ENDDO + ENDDO + MPI_WTIMES(119)=MPI_WTIMES(119)+MPI_TOC(S1TIME) + +C 601 FORMAT(' IMAX,JMAX,QWSFMAX = ',2I5,E14.5) +C 602 FORMAT(' IMIN,JMIN,QWSFMIN = ',2I5,E14.5) +C 603 FORMAT(' TOTAL SURF Q ERR = ',E14.5) +C + S1TIME=MPI_TIC() + call broadcast_boundary_array(W,ic) + MPI_WTIMES(140)=MPI_WTIMES(140)+MPI_TOC(S1TIME) +C +C ** CALCULATE U AND V ON OPEN BOUNDARIES +C + 30 CONTINUE +C + if(PRINT_SUM)then + call collect_in_zero_array(UHDY ) + call collect_in_zero_array(VHDX ) + call collect_in_zero_array(U ) + call collect_in_zero_array(V ) + call collect_in_zero_array(W ) + IF(MYRANK.EQ.0) PRINT*, '0UVW_UHDY = ', sum(abs(dble(UHDY))) + IF(MYRANK.EQ.0) PRINT*, '0UVW_VHDX = ', sum(abs(dble(VHDX))) + IF(MYRANK.EQ.0) PRINT*, '0UVW_U = ', sum(abs(dble(U ))) + IF(MYRANK.EQ.0) PRINT*, '0UVW_V = ', sum(abs(dble(V ))) + IF(MYRANK.EQ.0) PRINT*, '0UVW_W = ', sum(abs(dble(W ))) + endif + S1TIME=MPI_TIC() + DO K=1,KC + DO LL=1,NCBS + L=LCBS(LL) + LN=LNC(L) + LNN=LNC(LN) + IF(LN.NE.LC)THEN + VHDX(LN,K)=VHDX(LNN,K)-VHDXE(LNN)+VHDXE(LN) + V(LN,K)=VHDX(LN,K)/(HV(LN)*DXV(LN)) + ELSE + VHDX(LN,K)=0. + V(LN,K)=0. + ENDIF + ENDDO + ENDDO + DO K=1,KC + DO LL=1,NCBW + L=LCBW(LL) + LP=L+1 + LPP=L+2 + IF(LP.NE.LC)THEN + UHDY(LP,K)=UHDY(LPP,K)-UHDYE(LPP)+UHDYE(LP) + U(LP,K)=UHDY(LP,K)/(HU(LP)*DYU(LP)) + ELSE + UHDY(LP,K)=0. + U(LP,K)=0. + ENDIF + ENDDO + ENDDO + DO K=1,KC + DO LL=1,NCBE + L=LCBE(LL) + UHDY(L,K)=UHDY(L-1,K)-UHDYE(L-1)+UHDYE(L) + U(L,K)=UHDY(L,K)/(HU(L)*DYU(L)) + ENDDO + ENDDO + DO K=1,KC + DO LL=1,NCBN + L=LCBN(LL) + LS=LSC(L) + VHDX(L,K)=VHDX(LS,K)-VHDXE(LS)+VHDXE(L) + V(L,K)=VHDX(L,K)/(HV(L)*DXV(L)) + ENDDO + ENDDO + MPI_WTIMES(120)=MPI_WTIMES(120)+MPI_TOC(S1TIME) +C +C ** CALCULATE AVERAGE CELL FACE TRANSPORTS FOR SALT, TEMPERATURE AND +C ** SEDIMENT TRANSPORT AND PLACE IN UHDY2, VHDX2 AND W2 +C + if(PRINT_SUM)then + call collect_in_zero_array(UHDY1 ) + call collect_in_zero_array(VHDX1 ) + call collect_in_zero_array(U1 ) + call collect_in_zero_array(V1 ) + call collect_in_zero_array(W1 ) + call collect_in_zero_array(UHDY ) + call collect_in_zero_array(VHDX ) + call collect_in_zero_array(U ) + call collect_in_zero_array(V ) + call collect_in_zero_array(W ) + IF(MYRANK.EQ.0) PRINT*, '1UVW_UHDY = ', sum(abs(dble(UHDY))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_VHDX = ', sum(abs(dble(VHDX))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_U = ', sum(abs(dble(U ))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_V = ', sum(abs(dble(V ))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_W = ', sum(abs(dble(W ))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_UHDY1 = ', sum(abs(dble(UHDY1))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_VHDX1 = ', sum(abs(dble(VHDX1))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_U1 = ', sum(abs(dble(U1 ))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_V1 = ', sum(abs(dble(V1 ))) + IF(MYRANK.EQ.0) PRINT*, '1UVW_W1 = ', sum(abs(dble(W1 ))) + endif + IF(ISTL_.EQ.2)THEN + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY2(L,K)=0.5*(UHDY(L,K)+UHDY1(L,K)) + VHDX2(L,K)=0.5*(VHDX(L,K)+VHDX1(L,K)) + U2(L,K)=0.5*(U(L,K)+U1(L,K)) + V2(L,K)=0.5*(V(L,K)+V1(L,K)) + W2(L,K)=0.5*(W(L,K)+W1(L,K)) + ENDDO + ENDDO + MPI_WTIMES(121)=MPI_WTIMES(121)+MPI_TOC(S1TIME) + ELSE + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY2(L,K)=0.5*(UHDY(L,K)+UHDY2(L,K)) + VHDX2(L,K)=0.5*(VHDX(L,K)+VHDX2(L,K)) + U2(L,K)=0.5*(U(L,K)+U2(L,K)) + V2(L,K)=0.5*(V(L,K)+V2(L,K)) + W2(L,K)=0.5*(W(L,K)+W2(L,K)) + ENDDO + ENDDO + MPI_WTIMES(122)=MPI_WTIMES(122)+MPI_TOC(S1TIME) + ENDIF +C + if(PRINT_SUM)then + call collect_in_zero_array(UHDY2 ) + call collect_in_zero_array(VHDX2 ) + call collect_in_zero_array(U2 ) + call collect_in_zero_array(V2 ) + call collect_in_zero_array(W2 ) + IF(MYRANK.EQ.0) PRINT*, '2UVW_UHDY2 = ', sum(abs(dble(UHDY2))) + IF(MYRANK.EQ.0) PRINT*, '2UVW_VHDX2 = ', sum(abs(dble(VHDX2))) + IF(MYRANK.EQ.0) PRINT*, '2UVW_U2 = ', sum(abs(dble(U2 ))) + IF(MYRANK.EQ.0) PRINT*, '2UVW_V2 = ', sum(abs(dble(V2 ))) + IF(MYRANK.EQ.0) PRINT*, '2UVW_W2 = ', sum(abs(dble(W2 ))) + endif +C + IF(ISWVSD.GE.1)THEN + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY2(L,K)=UHDY2(L,K)+DYU(L)*UVPT(L,K) + VHDX2(L,K)=VHDX2(L,K)+DXV(L)*VVPT(L,K) + U2(L,K)=U2(L,K)+UVPT(L,K)/HMU(L) + V2(L,K)=V2(L,K)+VVPT(L,K)/HMV(L) ! *** Scott James + W2(L,K)=W2(L,K)+WVPT(L,K) + ENDDO + ENDDO + MPI_WTIMES(123)=MPI_WTIMES(123)+MPI_TOC(S1TIME) + ENDIF +C + if(PRINT_SUM)then + call collect_in_zero_array(UHDY2 ) + call collect_in_zero_array(VHDX2 ) + call collect_in_zero_array(U2 ) + call collect_in_zero_array(V2 ) + call collect_in_zero_array(W2 ) + IF(MYRANK.EQ.0) PRINT*, '3UVW_UHDY2 = ', sum(abs(dble(UHDY2))) + IF(MYRANK.EQ.0) PRINT*, '3UVW_VHDX2 = ', sum(abs(dble(VHDX2))) + IF(MYRANK.EQ.0) PRINT*, '3UVW_U2 = ', sum(abs(dble(U2 ))) + IF(MYRANK.EQ.0) PRINT*, '3UVW_V2 = ', sum(abs(dble(V2 ))) + IF(MYRANK.EQ.0) PRINT*, '3UVW_W2 = ', sum(abs(dble(W2 ))) + endif +C +C ** ADDITIONAL 3D CONTINUITY ADJUSTED ADDED BELOW +C + IF(KC.GT.1)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3E(L)=SUM(UHDY2(L,:)*DZC(:)) + TVAR3N(L)=SUM(VHDX2(L,:)*DZC(:)) + ENDDO + MPI_WTIMES(124)=MPI_WTIMES(124)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + call broadcast_boundary(TVAR3E,ic) + call broadcast_boundary(TVAR3N,ic) + MPI_WTIMES(141)=MPI_WTIMES(141)+MPI_TOC(S1TIME) + IF(ISGWIE.GE.1)THEN + IF(ISTL_.EQ.3)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(HPPTMP) + DO L=LMPI2,LMPILA + HPPTMP=H2P(L)+DELT*DXYIP(L)*( QSUME(L) + & -TVAR3E(L+1)+TVAR3E(L) + & -TVAR3N(LNC(L)) +TVAR3N(L) ) + & -DELT*DXYIP(L)*(RIFTR(L)+EVAPSW(L)) + HP(L)=SPB(L)*HPPTMP+(1.-SPB(L))*(GI*P(L)-BELV(L)) + HPI(L)=1./HP(L) + ENDDO + MPI_WTIMES(125)=MPI_WTIMES(125)+MPI_TOC(S1TIME) + ELSE + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(HPPTMP) + DO L=LMPI2,LMPILA + HPPTMP=H1P(L)+DELT*DXYIP(L)*( QSUME(L) + & -TVAR3E(L+1)+TVAR3E(L) + & -TVAR3N(LNC(L)) +TVAR3N(L) ) + & -DELT*DXYIP(L)*(RIFTR(L)+EVAPSW(L)) + HP(L)=SPB(L)*HPPTMP+(1.-SPB(L))*(GI*P(L)-BELV(L)) + HPI(L)=1./HP(L) + ENDDO + MPI_WTIMES(126)=MPI_WTIMES(126)+MPI_TOC(S1TIME) + ENDIF + ELSE + IF(ISTL_.EQ.3)THEN + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(HPPTMP) + DO L=LMPI2,LMPILA + HPPTMP=H2P(L)+DELT*DXYIP(L)*( QSUME(L) + & -TVAR3E(L+1)+TVAR3E(L) + & -TVAR3N(LNC(L)) +TVAR3N(L) ) + HP(L)=SPB(L)*HPPTMP+(1.-SPB(L))*(GI*P(L)-BELV(L)) + HPI(L)=1./HP(L) + ENDDO + MPI_WTIMES(127)=MPI_WTIMES(127)+MPI_TOC(S1TIME) + ELSE + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(HPPTMP) + DO L=LMPI2,LMPILA + HPPTMP=H1P(L)+DELT*DXYIP(L)*( QSUME(L) + & -TVAR3E(L+1)+TVAR3E(L) + & -TVAR3N(LNC(L)) +TVAR3N(L) ) + HP(L)=SPB(L)*HPPTMP+(1.-SPB(L))*(GI*P(L)-BELV(L)) + HPI(L)=1./HP(L) + ENDDO + MPI_WTIMES(128)=MPI_WTIMES(128)+MPI_TOC(S1TIME) + ENDIF + ENDIF + IF(MDCHH.GE.1)THEN + S1TIME=MPI_TIC() + RLAMN=QCHERR + RLAMO=1.-RLAMN + DO NMD=1,MDCHH + LHOST=LMDCHH(NMD) + LCHNU=LMDCHU(NMD) + LCHNV=LMDCHV(NMD) + IF(MDCHTYP(NMD).EQ.1)THEN + TMPVAL=DELT*(RLAMN*QCHANU(NMD)+RLAMO*QCHANUN(NMD)) + HP(LHOST)=HP(LHOST)+TMPVAL*DXYIP(LHOST) + HP(LCHNU)=HP(LCHNU)-TMPVAL*DXYIP(LCHNU) + HPI(LHOST)=1./HP(LHOST) + HPI(LCHNU)=1./HP(LCHNU) + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + TMPVAL=DELT*(RLAMN*QCHANV(NMD)+RLAMO*QCHANVN(NMD)) + HP(LHOST)=HP(LHOST)+TMPVAL*DXYIP(LHOST) + HP(LCHNV)=HP(LCHNV)-TMPVAL*DXYIP(LCHNV) + HPI(LHOST)=1./HP(LHOST) + HPI(LCHNV)=1./HP(LCHNV) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(129)=MPI_WTIMES(129)+MPI_TOC(S1TIME) + ENDIF +C + S1TIME=MPI_TIC() + call broadcast_boundary(HP,IC) + call broadcast_boundary(HPI,IC) + MPI_WTIMES(142)=MPI_WTIMES(142)+MPI_TOC(S1TIME) +C +C ** ACCUMULTATE MAX COURANT NUMBERS +C +C *** DSLLC BEGIN BLOCK + IF(ISINWV.EQ.1.OR.ISNEGH.GT.0)THEN + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO PRIVATE(CFLUUUT,CFLVVVT,CFLWWWT,CFLCACT) + DO L=LMPI2,LMPILA + CFLUUUT=DELT*ABS(DXIU(L)*U(L,K)) + CFLUUU(L,K)=MAX(CFLUUUT,CFLUUU(L,K)) + CFLVVVT=DELT*ABS(DYIV(L)*V(L,K)) + CFLVVV(L,K)=MAX(CFLVVVT,CFLVVV(L,K)) + CFLWWWT=DELT*ABS(HPI(L)*DZIG(K)*W(L,K)) + CFLWWW(L,K)=MAX(CFLWWWT,CFLWWW(L,K)) + CFLCACT=DELT*ABS(CAC(L,K)*DXYIP(L)*HPI(L)) + CFLCAC(L,K)=MAX(CFLCACT,CFLCAC(L,K)) + ENDDO + ENDDO + MPI_WTIMES(130)=MPI_WTIMES(130)+MPI_TOC(S1TIME) + ENDIF +C *** DSLLC END BLOCK +C +C ** CALCULATE NONHYDROSTATIC PRESSURE +C + S1TIME=MPI_TIC() + IF(KC.GT.1.AND.ISPNHYDS.GE.1) CALL CALPNHS_mpi + MPI_WTIMES(131)=MPI_WTIMES(131)+MPI_TOC(S1TIME) +C +C ** WRITE TO DIAGNOSTIC FILE CFL.OUT WITH DIAGNOSTICS OF MAXIMUM +C ** TIME STEP +C ** SEDIMENT TRANSPORT AND PLACE IN UHDY2, VHDX2 AND W2 +C +! IF(ISCFL.GE.1.AND.ISTL_.EQ.3.AND.DEBUG)THEN +! IF(ISCFL.GE.1.AND.DEBUG)THEN + IF(ISCFL.GE.1)THEN + S1TIME=MPI_TIC() + IF(MYRANK.EQ.0)THEN + OPEN(1,FILE='CFL.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF + IF(ISCFLM.GE.1.AND.N.EQ.1)THEN + IF(MYRANK.EQ.0)THEN + OPEN(2,FILE='CFLMP.OUT',STATUS='UNKNOWN') + CLOSE(2,STATUS='DELETE') + ENDIF + DO L=1,LC + ICFLMP(L)=0 + ENDDO + ENDIF + MPI_WTIMES(132)=MPI_WTIMES(132)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + DTCFL=1.E+18 + K=1 +!$OMP PARALLEL DO PRIVATE(LN,UWTMP,UETMP,VSTMP,VNTMP,WBTMP,WTTMP,DTMAXI,DTMAX +!$OMP+ ICFL,JCFL,KCFL) FIRSTPRIVATE(DTCFL) + DO L=LMPI2,LMPILA + LN=LNC(L) + UWTMP=ABS(DXIU(L )*U2(L ,K)) + UETMP=ABS(DXIU(L+1)*U2(L+1,K)) + VSTMP=ABS(DYIV(L )*V2(L ,K)) + VNTMP=ABS(DYIV(LN )*U2(LN ,K)) + WBTMP=0. + WTTMP=ABS(HPI(L)*DZIC(K)*W2(L,K)) + DTMAXI=MAX(UWTMP,UETMP)+MAX(VSTMP,VNTMP)+MAX(WBTMP,WTTMP) + & +1.0E-12 + DTMAX=0.5/DTMAXI + IF(DTMAX.LT.DTCFL)THEN + DTCFL=DTMAX + ICFL=IL(L) + JCFL=JL(L) + KCFL=K + ENDIF + ENDDO + MPI_WTIMES(133)=MPI_WTIMES(133)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(KC.GT.1)THEN + K=KC +!$OMP PARALLEL DO PRIVATE(LN,UWTMP,UETMP,VSTMP,VNTMP,WBTMP,WTTMP,DTMAXI,DTMAX +!$OMP+ ICFL,JCFL,KCFL) FIRSTPRIVATE(DTCFL) + DO L=LMPI2,LMPILA + LN=LNC(L) + UWTMP=ABS(DXIU(L )*U2(L ,K)) + UETMP=ABS(DXIU(L+1)*U2(L+1,K)) + VSTMP=ABS(DYIV(L )*V2(L ,K)) + VNTMP=ABS(DYIV(LN )*U2(LN ,K)) + WTTMP=0. + WBTMP=ABS(HPI(L)*DZIC(K)*W2(L,K-1)) + DTMAXI=MAX(UWTMP,UETMP)+MAX(VSTMP,VNTMP)+MAX(WBTMP,WTTMP) + & +1.0E-12 + DTMAX=0.5/DTMAXI + IF(DTMAX.LT.DTCFL)THEN + DTCFL=DTMAX + ICFL=IL(L) + JCFL=JL(L) + KCFL=K + ENDIF + ENDDO + ENDIF + MPI_WTIMES(134)=MPI_WTIMES(134)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(KC.GT.2)THEN + DO K=2,KS +!$OMP PARALLEL DO PRIVATE(LN,UWTMP,UETMP,VSTMP,VNTMP,WBTMP,WTTMP,DTMAXI,DTMAX +!$OMP+ ICFL,JCFL,KCFL) FIRSTPRIVATE(DTCFL) + DO L=LMPI2,LMPILA + LN=LNC(L) + UWTMP=ABS(DXIU(L )*U2(L ,K)) + UETMP=ABS(DXIU(L+1)*U2(L+1,K)) + VSTMP=ABS(DYIV(L )*V2(L ,K)) + VNTMP=ABS(DYIV(LN )*U2(LN ,K)) + WBTMP=ABS(HPI(L)*DZIC(K)*W2(L,K-1)) + WTTMP=ABS(HPI(L)*DZIC(K)*W2(L,K )) + DTMAXI=MAX(UWTMP,UETMP)+MAX(VSTMP,VNTMP)+MAX(WBTMP,WTTMP) + & +1.0E-12 + DTMAX=0.5/DTMAXI + IF(DTMAX.LT.DTCFL)THEN + DTCFL=DTMAX + ICFL=IL(L) + JCFL=JL(L) + KCFL=K + ENDIF + ENDDO + ENDDO + ENDIF + MPI_WTIMES(135)=MPI_WTIMES(135)+MPI_TOC(S1TIME) + + IF(.FALSE.)THEN + S1TIME=MPI_TIC() + IVAL=MOD(N,ISCFL) + IDTCFL=NINT(DTCFL) + MPI_WTIMES(136)=MPI_WTIMES(136)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(MYRANK.EQ.0)THEN + IF(ISCFL.EQ.1) WRITE(1,1212)DTCFL,N,ICFL,JCFL,KCFL + IF(ISCFL.GE.2.AND.IVAL.EQ.0 ) WRITE(1,1213)IDTCFL + ENDIF + MPI_WTIMES(137)=MPI_WTIMES(137)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISCFLM.GE.1 )THEN + LTMP=LIJ(ICFL,JCFL) + ICFLMP(LTMP)=ICFLMP(LTMP)+1 + ENDIF + IF(ISCFLM.GE.1.AND.N.EQ.NTS)THEN + IF(MYRANK.EQ.0)THEN + OPEN(2,FILE='CFLMP.OUT',STATUS='UNKNOWN') + TMPVALN=1./FLOAT(NTS) + DO L=2,LA + TMPVAL=TMPVALN*FLOAT(ICFLMP(L)) + WRITE(2,1214)IL(L),JL(L),ICFLMP(L),TMPVAL + ENDDO + CLOSE(2) + ENDIF + ENDIF + MPI_WTIMES(138)=MPI_WTIMES(138)+MPI_TOC(S1TIME) + ENDIF + IF(MYRANK.EQ.0) CLOSE(1) + + ENDIF + 1212 FORMAT(' MAX TIME STEP =',F10.2,' SEC FOR N,I,J,K =',I8,3I5) + 1213 FORMAT(I4) + 1214 FORMAT(2I5,I12,F10.2) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALVEGSER_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALVEGSER_mpi.for new file mode 100644 index 000000000..c02d4b33a --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALVEGSER_mpi.for @@ -0,0 +1,61 @@ + SUBROUTINE CALVEGSER_mpi (ISTL_) +C +C CHANGE RECORD +C NVEGSER = NUMBER OF VEGETATION TIME SERIES +C NVEGSERV(NVEGTPM) = TIME SERIES ID FOR SPECIFIC VEGETATION CLASS +C MVEGTLAST(NVEGSERM) = PLACE HOLDER IN INTERPOLATION TABLE +C TCVEGSER(NVEGSERM) = TIME CONVERSION FACTOR FOR TIME VARIABLE +C TVEGSER(NDVEGSER,NVEGSERM) = TIME OF DATA +C VEGSERRT(NVEGSERM) = CURRENT VALUE OF RDLPSQ +C VEGSERBT(NVEGSERM) = CURRENT VALUE OF BPVEG +C VEGSERHT(NVEGSERM) = CURRENT VALUE OF HPVEG +C VEGSERR(NDVEGSER,NVEGSERM) = TIME VARYING VALUES OF RDLPSQ +C VEGSERB(NDVEGSER,NVEGSERM) = TIME VARYING VALUES OF BPVEG +C VEGSERH(NDVEGSER,NVEGSERM) = TIME VARYING VALUES OF HPVEG +C ** SUBROUTINE CALVEGSR UPDATES TIME VARIABLE VEGETATION RESISTANCE +C ** PARAMETERS +C + USE GLOBAL + USE MPI + S1TIME=MPI_TIC() + IF(NVEGSER.GT.0)THEN + DO NS=1,NVEGSER + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)/TCVEGSER(NS)+TBEGIN*(TCON/TCVEGSER(NS)) + ELSE + TIME=TIMESEC/TCVEGSER(NS) + ENDIF + M1=MVEGTLAST(NS) + 100 CONTINUE + M2=M1+1 + IF(TIME.GT.TVEGSER(M2,NS))THEN + M1=M2 + GOTO 100 + ELSE + MVEGTLAST(NS)=M1 + ENDIF + TDIFF=TVEGSER(M2,NS)-TVEGSER(M1,NS) + WTM1=(TVEGSER(M2,NS)-TIME)/TDIFF + WTM2=(TIME-TVEGSER(M1,NS))/TDIFF + VEGSERRT(NS)=WTM1*VEGSERR(M1,NS)+WTM2*VEGSERR(M2,NS) + VEGSERBT(NS)=WTM1*VEGSERB(M1,NS)+WTM2*VEGSERB(M2,NS) + VEGSERHT(NS)=WTM1*VEGSERH(M1,NS)+WTM2*VEGSERH(M2,NS) + ENDDO + DO M=1,MVEGTYP + NSTMP=NVEGSERV(M) + IF(NSTMP.GT.0)THEN + RDLPSQ(M)=VEGSERRT(NSTMP) + BPVEG(M)=VEGSERBT(NSTMP) + HPVEG(M)=VEGSERHT(NSTMP) + BDLTMP=BPVEG(M)*BPVEG(M)*RDLPSQ(M) + PVEGX(M)=1.-BETVEG(M)*BDLTMP + PVEGY(M)=1.-BETVEG(M)*BDLTMP + PVEGZ(M)=1.-ALPVEG(M)*BDLTMP + BDLPSQ(M)=BPVEG(M)*RDLPSQ(M) + ENDIF + ENDDO + ENDIF + MPI_WTIMES(1201)=MPI_WTIMES(1201)+MPI_TOC(S1TIME) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC_mpi.for new file mode 100644 index 000000000..ab58f3e67 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALWQC_mpi.for @@ -0,0 +1,507 @@ + SUBROUTINE CALWQC_mpi(ISTL_,IS2TL_) +C +C CHANGE RECORD +C ** SUBROUTINE CALWQC CALCULATES THE CONCENTRATION OF DISSOLVED AND +C ** SUSPENDED WATER QUALITY CONSTITUTENTS AT TIME LEVEL (N+1). +C ** CALLED ONLY ON ODD THREE TIME LEVEL STEPS +C + USE GLOBAL + USE MPI + + LOGICAL WQC_MPI +C + WQC_MPI=.TRUE. +C + DELT=DT2 + IF(IS2TIM.GE.1) THEN + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ISUD=0 + ELSE + DELT=DTDYN + ISUD=0 + END IF + ENDIF +C +C ** UPDATED TIME SERIES CONCENTRATION BOUNDARY CONDITIONS +C ** 3D ADVECTI0N TRANSPORT CALCULATION +C +CGEO DO NW=0,NWQV +CGEO call collect_in_zero_array(WQV(:,:,NW)) +CGEO ENDDO +CGEO IF(MYRANK.EQ.0)THEN +CGEO PRINT*, n,'h1WQV = ', sum(abs(dble(WQV))) +CGEO ENDIF + S2TIME=MPI_TIC() + DO NW=1,NWQV + IF(ISTRWQ(NW).EQ.1)THEN + CALL CALTRAN_mpi(ISTL_,IS2TL_,8,NW,WQV(1,1,NW),WQV(1,1,NW)) + ENDIF + ENDDO + MPI_WTIMES(721)=MPI_WTIMES(721)+MPI_TOC(S2TIME) +C +CGEO DO NW=0,NWQV +CGEO call collect_in_zero_array(WQV(:,:,NW)) +CGEO ENDDO +CGEO IF(MYRANK.EQ.0)THEN +CGEO PRINT*, n,'h2WQV = ', sum(abs(dble(WQV))) +CGEO ENDIF + S2TIME=MPI_TIC() + DO NSP=1,NXSP + CALL CALTRAN_mpi(ISTL_,IS2TL_,8,NSP+NWQV, + & WQVX(1,1,NSP),WQVX(1,1,NSP)) + ENDDO + MPI_WTIMES(722)=MPI_WTIMES(722)+MPI_TOC(S2TIME) +CGEO DO NSP=1,NXSP; call collect_in_zero_array(WQVX(:,:,NSP)); ENDDO +CGEO DO NSP=1,NXSP +CGEO IF(MYRANK.EQ.0) PRINT*, 'a2',nsp,sum(abs(dble(WQVX(:,:,NSP)))) +CGEO ENDDO +C +C ** CALLS TO SOURCE-SINK CALCULATIONS +C ** BYPASS OR INITIALIZE VERTICAL DIFFUSION CALCULATION +C + IF(KC.EQ.1) GOTO 2000 + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HWQI(L)=1./HWQ(L) + ENDDO + MPI_WTIMES(723)=MPI_WTIMES(723)+MPI_TOC(S2TIME) +C +C ** VERTICAL DIFFUSION CALCULATION LEVEL 1 +C + IF(ISWQLVL.EQ.1)THEN + S2TIME=MPI_TIC() + RCDZKK=-DELT*CDZKK(1) + DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + WQV(L,1,NW)=WQV(L,1,NW)*EEB + ENDDO + ENDDO + MPI_WTIMES(724)=MPI_WTIMES(724)+MPI_TOC(S2TIME) +C + S2TIME=MPI_TIC() + DO NW=1,NWQV + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + WQV(L,K,NW)=(WQV(L,K,NW)-CCLBTMP*WQV(L,K-1,NW))*EEB + ENDDO + ENDDO + ENDDO + MPI_WTIMES(725)=MPI_WTIMES(725)+MPI_TOC(S2TIME) +C + S2TIME=MPI_TIC() + K=KC + RCDZKMK=-DELT*CDZKMK(K) + DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + WQV(L,K,NW)=(WQV(L,K,NW)-CCLBTMP*WQV(L,K-1,NW))*EEB + ENDDO + ENDDO + DO NW=1,NWQV + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQV(L,K,NW)=WQV(L,K,NW)-CU1(L,K)*WQV(L,K+1,NW) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(726)=MPI_WTIMES(726)+MPI_TOC(S2TIME) +C +C ** VERTICAL DIFFUSION CALCULATION LEVEL 2 +C + ELSEIF(ISWQLVL.EQ.2)THEN +C + S2TIME=MPI_TIC() + RCDZKK=-DELT*CDZKK(1) + DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + WQV(L,1,NW)=WQV(L,1,NW)*EEB + ENDDO + ENDDO + MPI_WTIMES(727)=MPI_WTIMES(727)+MPI_TOC(S2TIME) +C + S2TIME=MPI_TIC() + DO NW=1,NWQV + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + WQV(L,K,NW)=(WQV(L,K,NW)-CCLBTMP*WQV(L,K-1,NW))*EEB + ENDDO + ENDDO + ENDDO + MPI_WTIMES(728)=MPI_WTIMES(728)+MPI_TOC(S2TIME) +C + S2TIME=MPI_TIC() + K=KC + RCDZKMK=-DELT*CDZKMK(K) + DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + WQV(L,K,NW)=(WQV(L,K,NW)-CCLBTMP*WQV(L,K-1,NW))*EEB + ENDDO + ENDDO + DO NW=1,NWQV + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQV(L,K,NW)=WQV(L,K,NW)-CU1(L,K)*WQV(L,K+1,NW) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(729)=MPI_WTIMES(729)+MPI_TOC(S2TIME) +C +C ** VERTICAL DIFFUSION CALCULATION LEVEL 3 +C + ELSEIF(ISWQLVL.EQ.3)THEN + S2TIME=MPI_TIC() + IF(.FALSE.)THEN + RCDZKK=-DELT*CDZKK(1) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + WQV(L,1, 1)=WQV(L,1, 1)*EEB + WQV(L,1, 2)=WQV(L,1, 2)*EEB + WQV(L,1, 3)=WQV(L,1, 3)*EEB + WQV(L,1, 4)=WQV(L,1, 4)*EEB + WQV(L,1, 5)=WQV(L,1, 5)*EEB + WQV(L,1, 6)=WQV(L,1, 6)*EEB + WQV(L,1, 7)=WQV(L,1, 7)*EEB + WQV(L,1, 8)=WQV(L,1, 8)*EEB + WQV(L,1, 9)=WQV(L,1, 9)*EEB + WQV(L,1,10)=WQV(L,1,10)*EEB + WQV(L,1,11)=WQV(L,1,11)*EEB + WQV(L,1,12)=WQV(L,1,12)*EEB + WQV(L,1,13)=WQV(L,1,13)*EEB + WQV(L,1,14)=WQV(L,1,14)*EEB + WQV(L,1,15)=WQV(L,1,15)*EEB + WQV(L,1,16)=WQV(L,1,16)*EEB + WQV(L,1,17)=WQV(L,1,17)*EEB + WQV(L,1,18)=WQV(L,1,18)*EEB + WQV(L,1,19)=WQV(L,1,19)*EEB + WQV(L,1,20)=WQV(L,1,20)*EEB + WQV(L,1,21)=WQV(L,1,21)*EEB + ENDDO + !{ GEOSR X-species : jgcho 2015.11.09 + if (NXSP.gt.0) then + DO L=LF,LL + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + DO nsp=1,NXSP + WQVX(L,1,nsp)=WQVX(L,1,nsp)*EEB + ENDDO + enddo + endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + ELSE + RCDZKK=-DELT*CDZKK(1) + DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + WQV(L,1,NW)=WQV(L,1,NW)*EEB + ENDDO + ENDDO + IF(NXSP.GT.0)THEN + DO NSP=1,NXSP +!$OMP PARALLEL DO PRIVATE(CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCUBTMP=RCDZKK*HWQI(L)*AB(L,1) + CCMBTMP=1.-CCUBTMP + EEB=1./CCMBTMP + CU1(L,1)=CCUBTMP*EEB + WQVX(L,1,NSP)=WQVX(L,1,NSP)*EEB + ENDDO + ENDDO + ENDIF + ENDIF + MPI_WTIMES(730)=MPI_WTIMES(730)+MPI_TOC(S2TIME) +C + IF(.FALSE.)THEN + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + WQV(L,K, 1)=(WQV(L,K, 1)-CCLBTMP*WQV(L,K-1, 1))*EEB + WQV(L,K, 2)=(WQV(L,K, 2)-CCLBTMP*WQV(L,K-1, 2))*EEB + WQV(L,K, 3)=(WQV(L,K, 3)-CCLBTMP*WQV(L,K-1, 3))*EEB + WQV(L,K, 4)=(WQV(L,K, 4)-CCLBTMP*WQV(L,K-1, 4))*EEB + WQV(L,K, 5)=(WQV(L,K, 5)-CCLBTMP*WQV(L,K-1, 5))*EEB + WQV(L,K, 6)=(WQV(L,K, 6)-CCLBTMP*WQV(L,K-1, 6))*EEB + WQV(L,K, 7)=(WQV(L,K, 7)-CCLBTMP*WQV(L,K-1, 7))*EEB + WQV(L,K, 8)=(WQV(L,K, 8)-CCLBTMP*WQV(L,K-1, 8))*EEB + WQV(L,K, 9)=(WQV(L,K, 9)-CCLBTMP*WQV(L,K-1, 9))*EEB + WQV(L,K,10)=(WQV(L,K,10)-CCLBTMP*WQV(L,K-1,10))*EEB + WQV(L,K,11)=(WQV(L,K,11)-CCLBTMP*WQV(L,K-1,11))*EEB + WQV(L,K,12)=(WQV(L,K,12)-CCLBTMP*WQV(L,K-1,12))*EEB + WQV(L,K,13)=(WQV(L,K,13)-CCLBTMP*WQV(L,K-1,13))*EEB + WQV(L,K,14)=(WQV(L,K,14)-CCLBTMP*WQV(L,K-1,14))*EEB + WQV(L,K,15)=(WQV(L,K,15)-CCLBTMP*WQV(L,K-1,15))*EEB + WQV(L,K,16)=(WQV(L,K,16)-CCLBTMP*WQV(L,K-1,16))*EEB + WQV(L,K,17)=(WQV(L,K,17)-CCLBTMP*WQV(L,K-1,17))*EEB + WQV(L,K,18)=(WQV(L,K,18)-CCLBTMP*WQV(L,K-1,18))*EEB + WQV(L,K,19)=(WQV(L,K,19)-CCLBTMP*WQV(L,K-1,19))*EEB + WQV(L,K,20)=(WQV(L,K,20)-CCLBTMP*WQV(L,K-1,20))*EEB + WQV(L,K,21)=(WQV(L,K,21)-CCLBTMP*WQV(L,K-1,21))*EEB + ENDDO + ENDDO + !{ GEOSR X-species : jgcho 2015.11.09 + if (NXSP.gt.0) then + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + DO nsp=1,NXSP + WQVX(L,K,nsp)=(WQVX(L,K,nsp)-CCLBTMP*WQVX(L,K-1,nsp)) + & *EEB + ENDDO + enddo + enddo + endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + ELSE + S2TIME=MPI_TIC() +C DO NW=1,NWQV + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + WQV(L,K,1:NWQV)=(WQV(L,K,1:NWQV)-CCLBTMP + & *WQV(L,K-1,1:NWQV))*EEB + ENDDO + ENDDO +C ENDDO + MPI_WTIMES(731)=MPI_WTIMES(731)+MPI_TOC(S2TIME) + S2TIME=MPI_TIC() + IF(NXSP.GT.0)THEN +C DO NSP=1,NXSP + DO K=2,KS + RCDZKMK=-DELT*CDZKMK(K) + RCDZKK=-DELT*CDZKK(K) +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCUBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCUBTMP=RCDZKK*HWQI(L)*AB(L,K) + CCMBTMP=1.-CCLBTMP-CCUBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + CU1(L,K)=CCUBTMP*EEB + WQVX(L,K,1:NXSP)=(WQVX(L,K,1:NXSP)-CCLBTMP + & *WQVX(L,K-1,1:NXSP))*EEB + ENDDO + ENDDO +C ENDDO + ENDIF + MPI_WTIMES(732)=MPI_WTIMES(732)+MPI_TOC(S2TIME) + ENDIF +C + IF(.FALSE.)THEN + K=KC + RCDZKMK=-DELT*CDZKMK(K) + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + WQV(L,K, 1)=(WQV(L,K, 1)-CCLBTMP*WQV(L,K-1, 1))*EEB + WQV(L,K, 2)=(WQV(L,K, 2)-CCLBTMP*WQV(L,K-1, 2))*EEB + WQV(L,K, 3)=(WQV(L,K, 3)-CCLBTMP*WQV(L,K-1, 3))*EEB + WQV(L,K, 4)=(WQV(L,K, 4)-CCLBTMP*WQV(L,K-1, 4))*EEB + WQV(L,K, 5)=(WQV(L,K, 5)-CCLBTMP*WQV(L,K-1, 5))*EEB + WQV(L,K, 6)=(WQV(L,K, 6)-CCLBTMP*WQV(L,K-1, 6))*EEB + WQV(L,K, 7)=(WQV(L,K, 7)-CCLBTMP*WQV(L,K-1, 7))*EEB + WQV(L,K, 8)=(WQV(L,K, 8)-CCLBTMP*WQV(L,K-1, 8))*EEB + WQV(L,K, 9)=(WQV(L,K, 9)-CCLBTMP*WQV(L,K-1, 9))*EEB + WQV(L,K,10)=(WQV(L,K,10)-CCLBTMP*WQV(L,K-1,10))*EEB + WQV(L,K,11)=(WQV(L,K,11)-CCLBTMP*WQV(L,K-1,11))*EEB + WQV(L,K,12)=(WQV(L,K,12)-CCLBTMP*WQV(L,K-1,12))*EEB + WQV(L,K,13)=(WQV(L,K,13)-CCLBTMP*WQV(L,K-1,13))*EEB + WQV(L,K,14)=(WQV(L,K,14)-CCLBTMP*WQV(L,K-1,14))*EEB + WQV(L,K,15)=(WQV(L,K,15)-CCLBTMP*WQV(L,K-1,15))*EEB + WQV(L,K,16)=(WQV(L,K,16)-CCLBTMP*WQV(L,K-1,16))*EEB + WQV(L,K,17)=(WQV(L,K,17)-CCLBTMP*WQV(L,K-1,17))*EEB + WQV(L,K,18)=(WQV(L,K,18)-CCLBTMP*WQV(L,K-1,18))*EEB + WQV(L,K,19)=(WQV(L,K,19)-CCLBTMP*WQV(L,K-1,19))*EEB + WQV(L,K,20)=(WQV(L,K,20)-CCLBTMP*WQV(L,K-1,20))*EEB + WQV(L,K,21)=(WQV(L,K,21)-CCLBTMP*WQV(L,K-1,21))*EEB + ENDDO + !{ GEOSR X-species : jgcho 2015.11.09 + if (NXSP.gt.0) then + DO L=LF,LL + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + DO nsp=1,NXSP + WQVX(L,K,nsp)=(WQVX(L,K,nsp)-CCLBTMP*WQVX(L,K-1,nsp)) + & *EEB + ENDDO + enddo + endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + ELSE + S2TIME=MPI_TIC() + K=KC + RCDZKMK=-DELT*CDZKMK(K) +C DO NW=1,NWQV +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + WQV(L,K,1:NWQV)=(WQV(L,K,1:NWQV)-CCLBTMP + & *WQV(L,K-1,1:NWQV))*EEB + ENDDO +C ENDDO + MPI_WTIMES(733)=MPI_WTIMES(733)+MPI_TOC(S2TIME) + S2TIME=MPI_TIC() + IF(NXSP.GT.0)THEN +C DO NSP=1,NXSP +!$OMP PARALLEL DO PRIVATE(CCLBTMP,CCMBTMP,EEB) + DO L=LMPI2,LMPILA + CCLBTMP=RCDZKMK*HWQI(L)*AB(L,K-1) + CCMBTMP=1.-CCLBTMP + EEB=1./(CCMBTMP-CCLBTMP*CU1(L,K-1)) + WQVX(L,K,1:NXSP)=(WQVX(L,K,1:NXSP)-CCLBTMP + & *WQVX(L,K-1,1:NXSP))*EEB + ENDDO +C ENDDO + ENDIF + ENDIF + MPI_WTIMES(734)=MPI_WTIMES(734)+MPI_TOC(S2TIME) +C + IF(.FALSE.)THEN + DO ND=1,NDM + LF=2+(ND-1)*LDM + LL=LF+LDM-1 + DO K=KC-1,1,-1 + DO L=LF,LL + WQV(L,K, 1)=WQV(L,K, 1)-CU1(L,K)*WQV(L,K+1, 1) + WQV(L,K, 2)=WQV(L,K, 2)-CU1(L,K)*WQV(L,K+1, 2) + WQV(L,K, 3)=WQV(L,K, 3)-CU1(L,K)*WQV(L,K+1, 3) + WQV(L,K, 4)=WQV(L,K, 4)-CU1(L,K)*WQV(L,K+1, 4) + WQV(L,K, 5)=WQV(L,K, 5)-CU1(L,K)*WQV(L,K+1, 5) + WQV(L,K, 6)=WQV(L,K, 6)-CU1(L,K)*WQV(L,K+1, 6) + WQV(L,K, 7)=WQV(L,K, 7)-CU1(L,K)*WQV(L,K+1, 7) + WQV(L,K, 8)=WQV(L,K, 8)-CU1(L,K)*WQV(L,K+1, 8) + WQV(L,K, 9)=WQV(L,K, 9)-CU1(L,K)*WQV(L,K+1, 9) + WQV(L,K,10)=WQV(L,K,10)-CU1(L,K)*WQV(L,K+1,10) + WQV(L,K,11)=WQV(L,K,11)-CU1(L,K)*WQV(L,K+1,11) + WQV(L,K,12)=WQV(L,K,12)-CU1(L,K)*WQV(L,K+1,12) + WQV(L,K,13)=WQV(L,K,13)-CU1(L,K)*WQV(L,K+1,13) + WQV(L,K,14)=WQV(L,K,14)-CU1(L,K)*WQV(L,K+1,14) + WQV(L,K,15)=WQV(L,K,15)-CU1(L,K)*WQV(L,K+1,15) + WQV(L,K,16)=WQV(L,K,16)-CU1(L,K)*WQV(L,K+1,16) + WQV(L,K,17)=WQV(L,K,17)-CU1(L,K)*WQV(L,K+1,17) + WQV(L,K,18)=WQV(L,K,18)-CU1(L,K)*WQV(L,K+1,18) + WQV(L,K,19)=WQV(L,K,19)-CU1(L,K)*WQV(L,K+1,19) + WQV(L,K,20)=WQV(L,K,20)-CU1(L,K)*WQV(L,K+1,20) + WQV(L,K,21)=WQV(L,K,21)-CU1(L,K)*WQV(L,K+1,21) + ENDDO + ENDDO + !{ GEOSR X-species : jgcho 2015.11.09 + if (NXSP.gt.0) then + DO K=KC-1,1,-1 + DO L=LF,LL + DO nsp=1,NXSP + WQVX(L,K,nsp)=WQVX(L,K,nsp)-CU1(L,K)*WQVX(L,K+1,nsp) + ENDDO + enddo + enddo + endif + !} GEOSR X-species : jgcho 2015.11.09 + ENDDO + ELSE + S2TIME=MPI_TIC() +C DO NW=1,NWQV + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQV(L,K,1:NWQV)=WQV(L,K,1:NWQV)-CU1(L,K)*WQV(L,K+1,1:NWQV) + ENDDO + ENDDO +C ENDDO + MPI_WTIMES(735)=MPI_WTIMES(735)+MPI_TOC(S2TIME) + S2TIME=MPI_TIC() + IF(NXSP.GT.0)THEN +C DO NSP=1,NXSP + DO K=KC-1,1,-1 +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQVX(L,K,1:NXSP)=WQVX(L,K,1:NXSP)-CU1(L,K) + & *WQVX(L,K+1,1:NXSP) + ENDDO + ENDDO +C ENDDO + ENDIF + MPI_WTIMES(736)=MPI_WTIMES(736)+MPI_TOC(S2TIME) + ENDIF + ENDIF + 2000 CONTINUE + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD_mpi.for new file mode 100644 index 000000000..37def4a86 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CONGRAD_mpi.for @@ -0,0 +1,226 @@ + SUBROUTINE CONGRAD_mpi (ISTL_) +C +C CHANGE RECORD +C ** SUBROUTINE CONGRAD SOLVES THE EXTERNAL MODE BY A CONJUGATE +C ** GRADIENT SCHEME +C + USE GLOBAL + USE MPI + + ! *** DSLLC + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PNORTH + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PSOUTH + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPCG + REAL*8 :: RPC8G,PAPC8G,RPCG8N,ALPH8A,BET8A,RS8Q +! REAL*8 :: RPCG,PAPCG,RPCGN,RS8Q,ALPHA,BETA + IF(.NOT.ALLOCATED(PNORTH))THEN + ALLOCATE(PNORTH(LCM)) + ALLOCATE(PSOUTH(LCM)) + ALLOCATE(TMPCG(LCM)) + PNORTH=0.0 + PSOUTH=0.0 + TMPCG =0.0 + ENDIF + ! *** DSLLC +C +C CALL CPU_TIME(TTMP) +C + CALL broadcast_boundary(P,ic) + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PNORTH(L)=P(LNC(L)) + PSOUTH(L)=P(LSC(L)) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCG(L)=FPTMP(L)-CCC(L)*P(L)-CCN(L)*PNORTH(L)-CCS(L)*PSOUTH(L) + & -CCW(L)*P(L-1)-CCE(L)*P(L+1) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PCG(L)=RCG(L)*CCCI(L) + ENDDO + CALL broadcast_boundary(PCG,ic) + RPC8G=0. +! RPCG =0. +C!$OMP PARALLEL DO REDUCTION(+:RPCG) + DO L=LMPI2,LMPILA + RPC8G=RPC8G+RCG(L)*PCG(L) +! RPCG =RPCG +RCG(L)*PCG(L) + ENDDO + CALL MPI_ALLREDUCE(RPC8G,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) + RPC8G=MPI_R8 +! CALL MPI_ALLREDUCE(RPCG,MPI_R4,1,MPI_REAL, +! & MPI_SUM,MPI_COMM_WORLD,IERR) +! RPCG=MPI_R4 + MPI_WTIMES(242)=MPI_WTIMES(242)+MPI_TOC(S2TIME) +! PRINT*, '1',sum(abs(dble(RCG))),sum(abs(dble(PCG))),RPC8G + IF(RPC8G.EQ.0.0)RETURN ! *** DSLLC SINGLE LINE + ITER=0 + 100 CONTINUE + ITER=ITER+1 + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PNORTH(L)=PCG(LNC(L)) + PSOUTH(L)=PCG(LSC(L)) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + APCG(L)=CCC(L)*PCG(L)+CCS(L)*PSOUTH(L)+CCN(L)*PNORTH(L) + & +CCW(L)*PCG(L-1)+CCE(L)*PCG(L+1) + ENDDO + MPI_WTIMES(243)=MPI_WTIMES(243)+MPI_TOC(S2TIME) + PAPC8G=0. +! PAPCG =0. + S2TIME=MPI_TIC() +C!$OMP PARALLEL DO REDUCTION(+:PAPCG) + DO L=LMPI2,LMPILA + PAPC8G=PAPC8G+APCG(L)*PCG(L) +! PAPCG =PAPCG +APCG(L)*PCG(L) + ENDDO + CALL MPI_ALLREDUCE(PAPC8G,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) + PAPC8G=MPI_R8 +! CALL MPI_ALLREDUCE(PAPCG,MPI_R4,1,MPI_REAL, +! & MPI_SUM,MPI_COMM_WORLD,IERR) +! PAPCG=MPI_R4 + ALPH8A=(RPC8G)/(PAPC8G) +! ALPHA =RPCG/PAPCG +! PRINT*, '2',iter,sum(abs(dble(APCG))),sum(abs(dble(PCG))),PAPC8G, +! & RPC8G,ALPH8A +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + P(L)=REAL(P(L)+(ALPH8A)*PCG(L),KIND(P)) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCG(L)=REAL(RCG(L)-(ALPH8A)*APCG(L),KIND(RCG)) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TMPCG(L)=CCCI(L)*RCG(L) + ENDDO + MPI_WTIMES(244)=MPI_WTIMES(244)+MPI_TOC(S2TIME) + RPCG8N=0. + RS8Q =0. +! RPCGN =0. +! RSQ =0. + S2TIME=MPI_TIC() +C!$OMP PARALLEL DO REDUCTION(+:RPCGN,RS8Q) + DO L=LMPI2,LMPILA + RPCG8N=RPCG8N+RCG(L)*TMPCG(L) + RS8Q =RS8Q +RCG(L)*RCG(L) +! RPCGN =RPCGN +RCG(L)*TMPCG(L) +! RSQ =RSQ +RCG(L)*RCG(L) + ENDDO + CALL MPI_ALLREDUCE(RPCG8N,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) + RPCG8N=MPI_R8 + CALL MPI_ALLREDUCE(RS8Q,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) + RS8Q=MPI_R8 +! CALL MPI_ALLREDUCE(RPCGN,MPI_R4,1,MPI_REAL, +! & MPI_SUM,MPI_COMM_WORLD,IERR) +! RPCGN=MPI_R4 +! CALL MPI_ALLREDUCE(RSQ,MPI_R4,1,MPI_REAL, +! & MPI_SUM,MPI_COMM_WORLD,IERR) +! RSQ=MPI_R4 +c IF(MYRANK.EQ.0) PRINT*,RPCG8N,RS8Q,RPCGN,RSQ + MPI_WTIMES(245)=MPI_WTIMES(245)+MPI_TOC(S2TIME) +! PRINT*, '3',iter,sum(abs(dble(APCG))),sum(abs(dble(P))),RPCG8N +! PRINT*, '4',iter,sum(abs(dble(RCG))),sum(abs(dble(TMPCG))),RS8Q + IF(RS8Q.LE.RSQM) GOTO 200 + IF(ITER.GE.ITERM.AND.MYRANK.EQ.0)THEN + WRITE(6,600) +C +C *** PMC BEGIN BLOCK +C + WRITE(8,*)' I J CCS CCW CCC + & CCE CCN CDIADOM FPTMP HU + & HV' +C +C *** PMC END BLOCK +C + DO L=1,LC + CDIADOM=CCC(L)+CCE(L)+CCN(L)+CCS(L)+CCW(L) + WRITE(8,808)IL(L),JL(L),CCS(L),CCW(L),CCC(L),CCE(L),CCN(L), + & CDIADOM,FPTMP(L),HU(L),HV(L) + END DO + CLOSE(8) + STOP + ENDIF + BET8A =(RPCG8N)/(RPC8G) +! BETA =RPCGN/RPCG + +! CALL MPI_BARRIER(MPI_COMM_WORLD,IERR); STOP + + RPC8G=RPCG8N +! RPCG =RPCGN + S2TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PCG(L)=REAL(TMPCG(L)+(BET8A)*PCG(L),KIND(PCG)) + ENDDO + CALL broadcast_boundary(PCG,ic) + MPI_WTIMES(246)=MPI_WTIMES(246)+MPI_TOC(S2TIME) + GOTO 100 + 600 FORMAT(' MAXIMUM ITERATIONS EXCEEDED IN EXTERNAL SOLUTION') +C +C ** CALCULATE FINAL RESIDUAL +C + 200 CONTINUE + ! *** DSLLC BEGIN BLOCK + S2TIME=MPI_TIC() + CALL broadcast_boundary(P,ic) + IF(ISLOG.GE.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + PNORTH(L)=P(LNC(L)) + PSOUTH(L)=P(LSC(L)) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCG(L)=CCC(L)*P(L)+CCS(L)*PSOUTH(L)+CCN(L)*PNORTH(L) + & +CCW(L)*P(L-1)+CCE(L)*P(L+1)-FPTMP(L) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + RCG(L)=RCG(L)*CCCI(L) + ENDDO + RS8Q=0. +! RSQ =0. +C!$OMP PARALLEL DO REDUCTION(+:RQG) + DO L=LMPI2,LMPILA + RS8Q=RS8Q+RCG(L)*RCG(L) +! RSQ =RSQ+RCG(L)*RCG(L) + ENDDO + CALL MPI_ALLREDUCE(RS8Q,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) + RS8Q=MPI_R8 +! CALL MPI_ALLREDUCE(RSQ,MPI_R4,1,MPI_REAL, +! & MPI_SUM,MPI_COMM_WORLD,IERR) +! RSQ=MPI_R4 + ENDIF + MPI_WTIMES(247)=MPI_WTIMES(247)+MPI_TOC(S2TIME) + ! *** DSLLC END BLOCK +C TCONG=TCONG+TTMP-SECOND() +C 800 FORMAT(I5,8E13.4) + 808 FORMAT(2I5,9E13.4) + CALL broadcast_boundary(P,ic) + + IF(PRINT_SUM)THEN + call collect_in_zero(P) + call collect_in_zero(RCG) + call collect_in_zero(PCG) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'P = ', sum(abs(dble(P))) + PRINT*, n,'RCG = ', sum(abs(dble(RCG))) + PRINT*, n,'PCG = ', sum(abs(dble(PCG))) + ENDIF + ENDIF + + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for new file mode 100644 index 000000000..40c846247 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for @@ -0,0 +1,844 @@ + SUBROUTINE EEXPOUT_mpi(JSEXPLORER) + + !---------------------------------------------------------------- + + ! ** SUBROUTINE EEXPOUT WRITES UNFORMATTED OUTPUT FILES: + ! ** EE_WC - WATER COLUMN AND TOP LAYER OF SEDIMENTS + ! ** EE_BED - SEDIMENT BED LAYER INFORMATION + ! ** EE_WQ - WATER QUALITY INFORMATION FOR THE WATER COLUMN + ! ** EE_SD - SEDIMENT DIAGENSIS INFORMATION + ! ** EE_ARRAYS - GENERAL/USER DEFINED ARRAY DUMP. LINKED TO + ! ** EFDC_EXPLORER FOR DISPLAY + ! ** EE_SEDZLJ - SEDIMENT BED DATA FOR SEDZLJ SUB-MODEL + + !---------------------------------------------------------------- + + ! *** Notes: + + USE GLOBAL + USE MPI + + INTEGER*4 VER + CHARACTER*8 ARRAYNAME + INTEGER*4 IWQ(40), NACTIVE + INTEGER*4 JSEXPLORER,NS,NW,MW,NSEDSTEPS,NSXD + INTEGER*4 L,K,ISYS,NT,NX,N1 + REAL*4 TMPVAL,WQ + REAL*4 ZERO, SHEAR + + INTEGER NP1 + INTEGER COUNTCELL(LA) + + SAVE IWQ + SAVE NSEDSTEPS + + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + ENDIF + NACTIVE=LA-1 + +!{GEOSR, OIL, CWCHO, 101121 + S1TIME=MPI_TIC() + IF (IDTOX.GE.4440) THEN + ISTRAN(5)=1 + NTOX=1 + DO L=2,LA + DO K=1,KC + COUNTCELL(L)=0 + OILCONC=0.0 + DO NP1=1,NPD + IF(L==LLA(NP1)) THEN + COUNTCELL(L)=COUNTCELL(L)+1 + ENDIF + ENDDO + OILCONC(L,K,1)=OILMASS/REAL(NPD)*REAL(COUNTCELL(L)) + OILCONC(L,K,1)=OILCONC(L,K,1)/(DXP(L)*DYP(L)*HP(L))*1000. ! [mg/L] + TOX(L,K,1)=OILCONC(L,K,1) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(991)=MPI_WTIMES(992)+MPI_TOC(S1TIME) +!} + IF(JSEXPLORER.eq.0)THEN + IF(ISSPH(8).GE.1)THEN + call collect_in_zero_int(KBT) + call collect_in_zero(TAUBSED) + call collect_in_zero(TAUBSND) + call collect_in_zero(TAUB) + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + ENDDO + + call collect_in_zero(RSSBCE) + call collect_in_zero(RSSBCW) + call collect_in_zero(RSSBCN) + call collect_in_zero(RSSBCS) + call collect_in_zero(TBX) + call collect_in_zero(TBY) + + call collect_in_zero(WVWHA) + call collect_in_zero(WVFRQL) + call collect_in_zero(WACCWE) + + call collect_in_zero_array(SAL) + call collect_in_zero_array(TEM) + call collect_in_zero(TEMB) + call collect_in_zero_array(DYE) + call collect_in_zero_array(SFL) + + DO NT=1,NTXM + call collect_in_zero_array_kbm(TOXB(:,:,NT)) + call collect_in_zero_array(TOX(:,:,NT)) + ENDDO + + call collect_in_zero(BELV) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero_array_kbm(PORBED) + + DO NS=1,NSED + call collect_in_zero_array_kbm(SEDB(:,:,NS)) + call collect_in_zero_array_kbm(VFRBED(:,:,NS)) + call collect_in_zero_array(SED(:,:,NS)) + ENDDO + + DO NX=1,NSND + call collect_in_zero_array_kbm(SNDB(:,:,NX)) + call collect_in_zero_array_kbm(VFRBED(:,:,NX+NSED)) + call collect_in_zero_array(SND(:,:,NX)) + call collect_in_zero(CQBEDLOADX(:,NX)) + call collect_in_zero(CQBEDLOADY(:,NX)) + ENDDO + + ENDIF + + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0)THEN + call collect_in_zero_r8(TAU) + call collect_in_zero_r8(D50AVG) + call collect_in_zero_r8(ETOTO) + + DO NT=1,NSCM + call collect_in_zero_r8(CBL(1,:,NT)) + call collect_in_zero_r8(CBL(2,:,NT)) + call collect_in_zero_r8(XBLFLUX(:,NT)) + call collect_in_zero_r8(YBLFLUX(:,NT)) + DO K=1,KB + call collect_in_zero_r8(PER(NT,K,:)) + ENDDO + ENDDO + DO K=1,KB + call collect_in_zero_int(LAYER(K,:)) + call collect_in_zero_r8(TSED(K,:)) + call collect_in_zero_r8(BULKDENS(K,:)) + ENDDO + ENDIF + + IF(ISBEXP.GE.1)THEN + call collect_in_zero_int(KBT) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero_array_kbm(PORBED) + + DO NT=1,NTOX + call collect_in_zero_array_kbm(TOXB(:,:,NT)) + ENDDO + + DO NS=1,NSED + call collect_in_zero_array_kbm(SEDB(:,:,NS)) + call collect_in_zero_array_kbm(VFRBED(:,:,NS)) + ENDDO + + DO NX=1,NSND + call collect_in_zero_array_kbm(SNDB(:,:,NX)) + call collect_in_zero_array_kbm(VFRBED(:,:,NX+NSED)) + ENDDO + ENDIF + + IF(ISINWV.EQ.2)THEN + call collect_in_zero_array(FXWAVE) + call collect_in_zero_array(FYWAVE) + + call collect_in_zero(HP) + call collect_in_zero_array(AH) + call collect_in_zero_array(AV) + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + ENDDO + + call collect_in_zero_array(FMDUX) + call collect_in_zero_array(FMDUY) + call collect_in_zero_array(FMDVY) + call collect_in_zero_array(FMDVX) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + + call collect_in_zero(UHDYE) + call collect_in_zero(VHDXE) + + call collect_in_zero(FXE) + call collect_in_zero(FYE) + call collect_in_zero(DXIU) + call collect_in_zero(DYIV) + call collect_in_zero(AHC(:,1)) + call collect_in_zero(AHC(:,2)) + + call collect_in_zero_array(AHU) + call collect_in_zero_array(AMCU) + call collect_in_zero_array(AMCV) + call collect_in_zero_array(AMSU) + ENDIF + + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + + IF(PRINT_SUM.AND.MYRANK.EQ.0)THEN + PRINT*,n,'TAUBSED ',sum(abs(dble(TAUBSED))) + PRINT*,n,'TAUBSND ',sum(abs(dble(TAUBSND))) + PRINT*,n,'TAUB ',sum(abs(dble(TAUB))) + PRINT*,n,'RSSBCE ',sum(abs(dble(RSSBCE))) + PRINT*,n,'RSSBCW ',sum(abs(dble(RSSBCW))) + PRINT*,n,'RSSBCN ',sum(abs(dble(RSSBCN))) + PRINT*,n,'RSSBCS ',sum(abs(dble(RSSBCS))) + PRINT*,n,'TBX ',sum(abs(dble(TBX))) + PRINT*,n,'TBY ',sum(abs(dble(TBY))) + PRINT*,n,'WVWHA ',sum(abs(dble(WVWHA))) + PRINT*,n,'WVFRQL ',sum(abs(dble(WVFRQL))) + PRINT*,n,'WACCWE ',sum(abs(dble(WACCWE))) + PRINT*,n,'SAL ',sum(abs(dble(SAL))) + PRINT*,n,'TEM ',sum(abs(dble(TEM))) + PRINT*,n,'TEMB ',sum(abs(dble(TEMB))) + PRINT*,n,'DYE ',sum(abs(dble(DYE))) + PRINT*,n,'SFL ',sum(abs(dble(SFL))) + PRINT*,n,'TOXB ',sum(abs(dble(TOXB))) + PRINT*,n,'TOX ',sum(abs(dble(TOX))) + PRINT*,n,'HBED ',sum(abs(dble(HBED))) + PRINT*,n,'BDENBED ',sum(abs(dble(BDENBED))) + PRINT*,n,'PORBED ',sum(abs(dble(PORBED))) + PRINT*,n,'KBT ',sum(abs(dble(KBT))) + PRINT*,n,'SEDB ',sum(abs(dble(SEDB))) + PRINT*,n,'VFRBED ',sum(abs(dble(VFRBED))) + PRINT*,n,'SNDB ',sum(abs(dble(SNDB))) + PRINT*,n,'VFRBED ',sum(abs(dble(VFRBED))) + PRINT*,n,'CQBEDLOADX ',sum(abs(dble(CQBEDLOADX))) + PRINT*,n,'CQBEDLOADY ',sum(abs(dble(CQBEDLOADY))) + PRINT*,n,'WQV ',sum(abs(dble(WQV))) + PRINT*,n,'WQVX ',sum(abs(dble(WQVX))) + ENDIF + ENDIF + +C ** INITIAL CALL + S1TIME=MPI_TIC() + IF(JSEXPLORER.EQ.1.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=106 + WRITE(95)VER + WRITE(95)ISTRAN(1),ISTRAN(2),ISTRAN(3),ISTRAN(4) + WRITE(95)ISTRAN(5),ISTRAN(6),ISTRAN(7) + WRITE(95)NSED,NSND,KB,KC,NTOX + NSXD=NSED+NSND + DO NS=1,NSXD + WRITE(95)SEDDIA(NS) + ENDDO + CLOSE(95,STATUS='KEEP') + + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0)THEN + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)ITBM,NSICM + CLOSE(95,STATUS='KEEP') + ENDIF + + IF(ISBEXP.GE.1)THEN + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN + OPEN(10,FILE='EE_BED.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='EE_BED.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=106 + WRITE(10)VER + WRITE(10)ISTRAN(1),ISTRAN(2),ISTRAN(3),ISTRAN(4) + WRITE(10)ISTRAN(5),ISTRAN(6),ISTRAN(7) + WRITE(10)NSED,NSND,KB,KC,NTOX + DO NS=1,NSXD + WRITE(10)SEDDIA(NS) + ENDDO + CLOSE(10,STATUS='KEEP') + ENDIF + ENDIF + + IF(ISTRAN(8).GT.0)THEN + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NWQV + WRITE(95)(ISTRWQ(NW),NW=1,NWQV) + IWQ=0 + DO MW=1,NWQV + IWQ(MW)=ISTRWQ(MW) + ENDDO + WRITE(95)(IWQ(NW),NW=1,NWQV) + CLOSE(95,STATUS='KEEP') +!{ GEOSR X-species : jgcho 2015.10.14 + if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NXSP,LA,KC + CLOSE(95,STATUS='KEEP') + endif ! if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 +!} GEOSR X-species : jgcho 2015.10.14 + + ! *** SAVE SEDIMENT DIAGENESIS RESULTS + IF(ISSDBIN.LT.0)THEN + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NACTIVE + CLOSE(95,STATUS='KEEP') + NSEDSTEPS=-1 + ENDIF + ENDIF + ELSEIF(JSEXPLORER.EQ.-1)THEN + ! *** FORCE ALL OUTPUT + NSEDSTEPS=32000 + ENDIF + MPI_WTIMES(992)=MPI_WTIMES(992)+MPI_TOC(S1TIME) + +C *** WRITE SNAPSHOT + S1TIME=MPI_TIC() + IF(ISDYNSTP.EQ.0)THEN + EETIME=DT*FLOAT(N)+TCON*TBEGIN + ELSE + EETIME=TIMESEC + ENDIF + IF(JSEXPLORER.EQ.1)EETIME=TCON*TBEGIN + EETIME=EETIME/86400. + + IF(ISSPH(8).GE.1.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_WC.OUT',STATUS='OLD', + & POSITION='APPEND',FORM='UNFORMATTED') + WRITE(95)EETIME,NACTIVE + DO L=2,LA + N1=KBT(L) + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + IF(ISBEDSTR.GE.1.AND.NSEDFLUME.EQ.0)THEN + WRITE(95)TAUBSED(L) + IF(ISBEDSTR.EQ.1)THEN + WRITE(95)TAUBSND(L) + ENDIF + ELSE + WRITE(95)TAUB(L) + ENDIF + ELSE + SHEAR=MAX(QQ(L,0),QQMIN)/CTURB2 + WRITE(95)SHEAR + ENDIF + IF(ISWAVE.GE.1)THEN + ! *** Shear due to Current Only + SHEAR = (RSSBCE(L)*TBX(L+1 )+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TBY(LNC(L))+RSSBCS(L)*TBY(L))**2 + SHEAR=0.5*SQRT(SHEAR) + WRITE(95)SHEAR + IF(ISWAVE.EQ.3)THEN + WRITE(95)WVWHA(L),WVFRQL(L),WACCWE(L) + ENDIF + ENDIF + IF(ISTRAN(1).EQ.1)WRITE(95)(SAL(L,K),K=1,KC) + IF(ISTRAN(2).EQ.1)THEN + WRITE(95)(TEM(L,K),K=1,KC) + IF(TBEDIT.GT.0.)WRITE(95)TEMB(L) + ENDIF + IF(ISTRAN(3).EQ.1)WRITE(95,ERR=999,IOSTAT=ISYS) + & (DYE(L,K),K=1,KC) + IF(ISTRAN(4).EQ.1)WRITE(95)(SFL(L,K),K=1,KC) + IF(ISTRAN(5).EQ.1)THEN + WRITE(95)(TOXB(L,N1,NT),NT=1,NTOX) + WRITE(95)((TOX(L,K,NT),K=1,KC),NT=1,NTOX) + ENDIF + IF(ISTRAN(6).EQ.1.OR.ISTRAN(7).GE.1)THEN + WRITE(95)N1,BELV(L),HBED(L,N1),BDENBED(L,N1),PORBED(L,N1) + IF(ISTRAN(6).EQ.1)THEN + WRITE(95)(SEDB(L,N1,NS),VFRBED(L,N1,NS),NS=1,NSED) + WRITE(95)((SED(L,K,NS),K=1,KC),NS=1,NSED) + ENDIF + IF(ISTRAN(7).EQ.1)THEN + WRITE(95)(SNDB(L,N1,NX),VFRBED(L,N1,NX+NSED),NX=1,NSND) + WRITE(95)((SND(L,K,NX),K=1,KC),NX=1,NSND) + IF(ISBDLDBC.GT.0)THEN + WRITE(95)(CQBEDLOADX(L,NX),CQBEDLOADY(L,NX),NX=1,NSND) + ENDIF + ENDIF + ENDIF + ENDDO + IF(MYRANK.EQ.0) CALL FLUSH(95) + IF(MYRANK.EQ.0) CLOSE(95,STATUS='KEEP') + ENDIF + MPI_WTIMES(993)=MPI_WTIMES(993)+MPI_TOC(S1TIME) + + ! *** OUTPUT THE SEDZLJ VARIABLES + S1TIME=MPI_TIC() + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='OLD', + & POSITION='APPEND',FORM='UNFORMATTED') + + WRITE(95)EETIME,NACTIVE + + DO L=2,LA + WRITE(95) REAL(TAU(L)) !TAU(LCM) - Shear Stress in dynes/cm^2 + WRITE(95) REAL(D50AVG(L)) !D50AVG(LCM) - Average particle size of bed surface (microns) + WRITE(95) REAL(ETOTO(L)) !ETOTO(LCM) - Total erosion in the cell + DO NT=1,NSCM + WRITE(95) REAL(CBL(1,L,NT)) !CBL(NSCM,LCM) - This is the bedload concentration in g/cm^3 of each size class + WRITE(95) REAL(XBLFLUX(L,NT)) !XBLFLUX(LCM,NSCM) - Bedload flux in X direction (g/s) + WRITE(95) REAL(YBLFLUX(L,NT)) !YBLFLUX(LCM,NSCM) - Bedload flux in Y direction (g/s) + DO K=1,KB + WRITE(95) REAL(PER(NT,K,L)) !PER(NSCM,KB,LCM) - This is the mass percentage of each size class in a layer + ENDDO + ENDDO + DO K=1,KB + WRITE(95) LAYER(K,L) !LAYER(KB,LCM) - This is = 1 when a bed layer (KB index) exists with mass + WRITE(95) REAL(TSED(K,L)) !TSED(KB,LCM) - This is the mass in g/cm^2 in each layer + WRITE(95) REAL(BULKDENS(K,L)) !BULKDENS(KB,LCM) - Dry Bulk density of each layer (g/cm^3) + ENDDO + ENDDO + + IF(MYRANK.EQ.0) CALL FLUSH(95) + IF(MYRANK.EQ.0) CLOSE(95,STATUS='KEEP') + ENDIF + MPI_WTIMES(994)=MPI_WTIMES(994)+MPI_TOC(S1TIME) + +C *** NOW OUTPUT ALL THE BEDINFO TO A SINGLE FILE + S1TIME=MPI_TIC() + IF(ISBEXP.GE.1.AND.MYRANK.EQ.0)THEN + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1.AND.KB.GT.1)THEN + OPEN(87,FILE='EE_BED.OUT',STATUS='UNKNOWN',POSITION='APPEND' + & ,FORM='UNFORMATTED') + WRITE(87)EETIME,NACTIVE + DO L=2,LA + WRITE(87)KBT(L) + ENDDO + DO L=2,LA + DO K=1,KB + WRITE(87)HBED(L,K),BDENBED(L,K),PORBED(L,K) + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED + WRITE(87)SEDB(L,K,NS),VFRBED(L,K,NS) + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NX=1,NSND + NS=NSED+NX + WRITE(87)SNDB(L,K,NX),VFRBED(L,K,NS) + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX + WRITE(87)TOXB(L,K,NT) + ENDDO + ENDIF + ENDDO + ENDDO + CALL FLUSH(87) + CLOSE(87,STATUS='KEEP') + ENDIF + ENDIF + MPI_WTIMES(995)=MPI_WTIMES(995)+MPI_TOC(S1TIME) + +C *** INTERNAL ARRAYS + S1TIME=MPI_TIC() + IF(ISINWV.EQ.2.AND.JSEXPLORER.LE.0.AND.MYRANK.EQ.0)THEN + ZERO=0.0 + IF(N.LT.(2*NTSPTC/NPSPH(8)))THEN + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)3 ! # OF TIME VARYING ARRAYS + + ! FLAGS: ARRAY TYPE, TIME VARIABLE + ! ARRAY TYPE: 0 = L DIM'D + ! 1 = L,KC DIM'D + ! 2 = L,0:KC DIM'D + ! 3 = L,KB DIM'D + ! 4 = L,KC,NCLASS DIM'D + ! TIME VARIABLE: 0 = NOT CHANGING + ! 1 = TIME VARYING + + !WRITE(95)0,0 + !ARRAYNAME='SUB' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)SUB(L) + !ENDDO + + !WRITE(95)0,0 + !ARRAYNAME='SVB' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)SVB(L) + !ENDDO + + WRITE(95)1,0 + ARRAYNAME='FXWAVE' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FXWAVE(L,K) + ENDDO + ENDDO + + WRITE(95)1,0 + ARRAYNAME='FYWAVE' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FYWAVE(L,K) + ENDDO + ENDDO + + ELSE + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN', + & POSITION='APPEND',FORM='UNFORMATTED') + ENDIF + + IF(.TRUE.)THEN + + WRITE(95)1,1 + ARRAYNAME='AH' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AH(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='AV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)(AV(L,K)*HP(L)) + ENDDO + ENDDO + + WRITE(95)2,1 + ARRAYNAME='QQ' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=0,KC + WRITE(95)QQ(L,K) + ENDDO + ENDDO + + IF(.FALSE.)THEN + ! *** FMDUX FMDUY FMDVY FMDVX + WRITE(95)1,1 + ARRAYNAME='FMDUX' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDUX(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='FMDUY' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDUY(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FMDVY' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDVY(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FMDVX' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDVX(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='U' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)U(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='V' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)V(L,K) + ENDDO + ENDDO + + WRITE(95)0,1 + ARRAYNAME='UHDYE' + WRITE(95)ARRAYNAME + DO L=2,LA + WRITE(95)UHDYE(L) + ENDDO + + WRITE(95)0,1 + ARRAYNAME='VHDXE' + WRITE(95)ARRAYNAME + DO L=2,LA + WRITE(95)VHDXE(L) + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FXE' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=FXE(L)*DELT*DXIU(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FYE' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=FYE(L)*DELT*DYIV(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FUHX' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=AHC(L,1)*DELT*DXIU(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FVHY' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=AHC(L,2)*DELT*DYIV(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)1,1 + ARRAYNAME='FUHU' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AHU(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FVHU' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMCU(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FVHV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMCV(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FUHV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMSU(L,K) + ENDDO + ENDDO + + ENDIF + + !WRITE(95)0,1 + !ARRAYNAME='TATMT' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)TATMT(L) + !ENDDO + ENDIF +C + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + + ENDIF + MPI_WTIMES(996)=MPI_WTIMES(996)+MPI_TOC(S1TIME) + +C *** WATER QUALITY + IF(ISTRAN(8).GT.0.AND.MYRANK.EQ.0)THEN + ! 1) CHC - cyanobacteria + ! 2) CHD - diatom algae + ! 3) CHG - green algae + ! 4) ROC - refractory particulate organic carbon + ! 5) LOC - labile particulate organic carbon + ! 6) DOC - dissolved organic carbon + ! 7) ROP - refractory particulate organic phosphorus + ! 8) LOP - labile particulate organic phosphorus + ! 9) DOP - dissolved organic phosphorus + ! 10) P4D - total phosphate + ! 11) RON - refractory particulate organic nitrogen 22) macroalgae + ! 12) LON - labile particulate organic nitrogen + ! 13) DON - dissolved organic nitrogen + ! 14) NHX - ammonia nitrogen + ! 15) NOX - nitrate nitrogen + ! 16) SUU - particulate biogenic silica + ! 17) SAA - dissolved available silica + ! 18) COD - chemical oxygen demand + ! 19) DOX - dissolved oxygen + ! 20) TAM - total active metal + ! 21) FCB - fecal coliform bacteria + S1TIME=MPI_TIC() + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME + DO L=2,LA + DO K=1,KC + DO NW=1,NWQV + IF(IWQ(NW).GT.0)THEN + WQ=WQV(L,K,NW) + WRITE(95)WQ + ENDIF + ENDDO + ENDDO + ENDDO + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + MPI_WTIMES(997)=MPI_WTIMES(997)+MPI_TOC(S1TIME) +!{ GEOSR X-species : jgcho 2015.10.14 + S1TIME=MPI_TIC() + if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME,N + do nsp=1,NXSP + do K=1,KC + do L=2,LA + WQ=WQVX(L,K,nsp) + WRITE(95)WQ + ENDDO + ENDDO + ENDDO + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + endif !if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + MPI_WTIMES(998)=MPI_WTIMES(998)+MPI_TOC(S1TIME) +!} GEOSR X-species : jgcho 2015.09.18 + ! *** SAVE SEDIMENT DIAGENESIS RESULTS + S1TIME=MPI_TIC() + IF(IWQBEN.GT.0.AND.ISSDBIN.LT.0)THEN + ! *** IF JSEXPLORER=1 THEN WRITE THE ARRAYS (I.E. IC'S) + NSEDSTEPS=NSEDSTEPS+1 + IF(NSEDSTEPS.GE.ABS(ISSDBIN).OR.JSEXPLORER.EQ.1)THEN + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME + DO L=2,LA + + ! SMPON = Conc. Particulate Org. Nitrogen in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + ! SMPOP = Conc. Particulate Org. Phosphorus in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + ! SMPOC = Conc. Particulate Org. Carbon in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + + ! *** DEPOSITION FLUXES + ! SMDFN(LL,?) = Sediment Flux To The Sediment Bed From PON Into G1, G2, & G3 + ! SMDFP(LL,?) = Sediment Flux To The Sediment Bed From POP Into G1, G2, & G3 + ! SMDFC(LL,?) = Sediment Flux To The Sediment Bed From POC Into G1, G2, & G3 + + ! SM1NH4 = Conc. NH4-N in layer 1 (g/m3) dim(LA) + ! SM2NH4 = Conc. NH4-N in layer 2 (g/m3) + ! SM1NO3 = Conc. NO3-N in layer 1 (g/m3) + ! SM2NO3 = Conc. NO3-N in layer 2 (g/m3) + ! SM1PO4 = Conc. PO4-P in layer 1 (g/m3) + ! SM2PO4 = Conc. PO4-P in layer 2 (g/m3) + ! SM1H2S = Conc. Sulfide (H2S) in layer 1 (g/m3) + ! SM2H2S = Conc. Sulfide (H2S) in layer 2 (g/m3) + ! SMPSI = Conc. Particulate biogenic silica in layer 2 (g/m3) + ! SM1SI = Conc. Dissolved available silica in layer 1 (g/m3) + ! SM2SI = Conc. Dissolved available silica in layer 2 (g/m3) + ! SMBST = Accumulated benthic stress (days) + ! SMT = Sediment temperature (degC) + + ! *** SEDIMENT OXYGEN DEMANDS + ! SMCSOD = CARBONACEOUS SOD + ! SMNSOD = NITROGENOUS SOD + + ! *** BENTHIC FLUXES + ! WQBFNH4 = AMMONIUM FLUX + ! WQBFNO3 = NITRATE FLUX + ! WQBFO2 = O2 SEDIMENT FLUX (SOD) + ! WQBFCOD = COD FLUX + ! WQBFPO4D = PO4 FLUX + ! WQBFSAD = SILICA FLUX + + WRITE(95)(SMPON(L,K),K=1,3) + WRITE(95)(SMPOP(L,K),K=1,3) + WRITE(95)(SMPOC(L,K),K=1,3) + WRITE(95)(SMDFN(L,K),K=1,3) + WRITE(95)(SMDFP(L,K),K=1,3) + WRITE(95)(SMDFC(L,K),K=1,3) + WRITE(95)SM1NH4(L),SM2NH4(L) + WRITE(95)SM1NO3(L),SM2NO3(L) + WRITE(95)SM1PO4(L),SM2PO4(L) + WRITE(95)SM1H2S(L),SM2H2S(L) + WRITE(95)SM1SI(L), SM2SI(L) + WRITE(95)SMPSI(L) + WRITE(95)SMBST(L),SMT(L) + WRITE(95)SMCSOD(L),SMNSOD(L) + WRITE(95)WQBFNH4(L),WQBFNO3(L),WQBFO2(L),WQBFCOD(L), + & WQBFPO4D(L),WQBFSAD(L) + ENDDO + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + NSEDSTEPS=0 + ENDIF + ENDIF + ENDIF + MPI_WTIMES(999)=MPI_WTIMES(999)+MPI_TOC(S1TIME) + + RETURN + + 999 STOP ' Error writing SNAPSHOT file' + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for new file mode 100644 index 000000000..c6ad589df --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for @@ -0,0 +1,2713 @@ + SUBROUTINE HDMT2T_mpi +C +C ** SUBROUTINE HDMT2T EXECUTES THE FULL HYDRODYNAMIC AND MASS +C ** TRANSPORT TIME INTERGATION USING A TWO TIME LEVEL SCHEME +C +C ** THIS SUBROUTINE IS PART OF EFDC-FULL VERSION +C +C----------------------------------------------------------------------C +C +C CHANGE RECORD +C DATE MODIFIED BY DATE APPROVED BY +C +C 05/01/2002 John Hamrick 05/01/2002 John Hamrick +C modified calls to calbal and budget subroutines +C added calls to bal2t1, bal2t4, bal2t5 +C 05/02/2002 John Hamrick 05/01/2002 John Hamrick +C modified calculation of cell center bed stress (stored as QQ(l,0)) +C for cells have source/sinks +C 09-22-2004 Paul M. Craig +C Merged DS and TT versions with the 06-04-2004 TT code +C----------------------------------------------------------------------C +C +C**********************************************************************C +C + USE GLOBAL + USE DRIFTER + USE WINDWAVE ,ONLY:WINDWAVEINIT,WINDWAVETUR + USE MPI + + REAL TTMP, T1TMP, TMP, T2TMP + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::ISSBCP + LOGICAL BTEST, LTEST, ERRTEST + + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WCOREW + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WCORNS + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LCORNER + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LCORNWE + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::LCORNSN + +! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 + INTEGER ISHYD,IHYDCNT + INTEGER ISAVESEDDT + INTEGER LN + REAL SNAPSHOTHYD + INTEGER NTMPVAL + IHYDCNT=0 + NTMPVAL=0 + SNAPSHOTHYD=0.0 + BTEST=.FALSE. + LN=0 + ISAVESEDDT=0 +! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 +C +![ykchoi 10.04.26 for linux version +! INTERFACE TO FUNCTION KBHIT +! & [C,ALIAS:'__kbhit'] +! & () +! LOGICAL KBHIT*1 +! END +! INTERFACE TO FUNCTION GETCH +! & [C,ALIAS:'__getch'] +! & () +! INTEGER GETCH*1 +! END +!ykchoi] +C + IF(.NOT.ALLOCATED(WCOREW))THEN + ALLOCATE(WCOREW(LCM)) + ALLOCATE(WCORNS(LCM)) + ALLOCATE(LCORNER(LCM)) + ALLOCATE(LCORNWE(LCM)) + ALLOCATE(LCORNSN(LCM)) + ! *** ALLOCATE LOCAL ARRAYS + WCOREW=0.0 + WCORNS=0.0 + LCORNER=0 + LCORNWE=0 + LCORNSN=0 + ENDIF +C + CALL CPU_TIME(TTMP) + ICALLTP=0 +C + ISTL=2 + FOURDPI=4./PI + ISTL=2 + IS2TL=1 + MPI_WTIMES=0 + CALL ISINPUTS(IS_PSER,IS_CSER,IS_QSER,IS_QCTL) +C +C**********************************************************************C +C +C ** SET FLAGS FOR CORNER CELL BED STRESS CORRECTIONS +C +C *** DSLLC BEGIN BLOCK + IF(ISCORTBC.GE.1) THEN +C +C ** SET FLAG FOR CELLS HAVING VOLUME SOURCE OR SINKS +C + IF(.NOT.ALLOCATED(ISSBCP))ALLOCATE(ISSBCP(LCM)) + DO L=1,LC + ISSBCP(L)=0 + ENDDO +C + DO L=2,LA + IF(RSSBCE(L).GT.1.5)ISSBCP(L)=1 + IF(RSSBCW(L).GT.1.5)ISSBCP(L)=1 + IF(RSSBCN(L).GT.1.5)ISSBCP(L)=1 + IF(RSSBCS(L).GT.1.5)ISSBCP(L)=1 + ENDDO +C + ENDIF +C + DO L=2,LA + WCOREST(L)=1. + WCORWST(L)=1. + WCORNTH(L)=1. + WCORSTH(L)=1. + ENDDO + ! *** DSLLC +C +C**********************************************************************C +C +C ** REINITIALIZE VARIABLES +C + DO L=2,LA + H1P(L)=HP(L) + H1U(L)=HU(L) + H1UI(L)=HUI(L) + H1V(L)=HV(L) + H1VI(L)=HVI(L) + UHDY1E(L)=UHDYE(L) + VHDX1E(L)=VHDXE(L) + ENDDO +C + DO K=1,KC + DO L=2,LA + U1(L,K)=U(L,K) + V1(L,K)=V(L,K) + UHDY1(L,K)=UHDY(L,K) + VHDX1(L,K)=VHDX(L,K) + ENDDO + ENDDO +C +C**********************************************************************C +C +C ** INITIALIZE COURANT NUMBER DIAGNOSTICS +C + DO K=1,KC + DO L=2,LA + CFLUUU(L,K)=0. + CFLVVV(L,K)=0. + CFLWWW(L,K)=0. + CFLCAC(L,K)=0. + ENDDO + ENDDO +C +C**********************************************************************C +C + ILOGC=0 +C +C**********************************************************************C +C +C ** CALCULATE U AT V AND V AT U USING ENERGY CONSERVING WEIGHTING +C ** CALCULATE VELOCITY GRADIENTS +C +C----------------------------------------------------------------------C +C + DO L=2,LA + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + LSW=LSWC(L) + + UV(L)=0.25*(HP(LS)*(U(LSE,1)+U(LS,1)) + & +HP(L)*(U(L+1,1)+U(L,1)))*HVI(L) + U1V(L)=0.25*(H1P(LS)*(U1(LSE,1)+U1(LS,1)) + & +H1P(L)*(U1(L+1,1)+U1(L,1)))*H1VI(L) + VU(L)=0.25*(HP(L-1)*(V(LNW,1)+V(L-1,1)) + & +HP(L)*(V(LN,1)+V(L,1)))*HUI(L) + V1U(L)=0.25*(H1P(L-1)*(V1(LNW,1)+V1(L-1,1)) + & +H1P(L)*(V1(LN,1)+V1(L,1)))*H1UI(L) + ! *** DSLLC END BLOCK + ENDDO + +C +C**********************************************************************C +C +C ** CALCULATE WAVE BOUNDARY LAYER AND WAVE REYNOLDS STRESS FORCINGS +C +CC IF(N.EQ.1.AND.MYRANK.EQ.0) PRINT*,'SWITCH ISWAVE',ISWAVE + IF(ISWAVE.EQ.1) CALL WAVEBL + IF(ISWAVE.EQ.2) CALL WAVESXY + IF(ISWAVE.EQ.3.AND.NWSER > 0) THEN + CALL WINDWAVEINIT + CALL WINDWAVETUR !DHC FIRST CALL + ENDIF +C +C**********************************************************************C +C +C ** FIRST CALL TO INITIALIZE BOTTOM STRESS COEFFICINETS +C + DTDYN=DT ! *** PMC - FOR INITIALIZATION + CALL CALTBXY_mpi(ISTL,IS2TL) +C +C**********************************************************************C +C +C ** CALCULATE HORIZONTAL VISCOSITY AND DIFFUSIVE MOMENTUM FLUXES +C + IF(ISHDMF.GE.1) CALL CALHDMF_mpi +C +C**********************************************************************C +C +C ** CALCULATE BOTTOM AND SURFACE STRESS AT TIME LEVEL (N-1) AND N +C +C----------------------------------------------------------------------C +C + N=-1 + CALL CALTSXY_mpi +C +C**********************************************************************C +C +C ** SECOND CALL TO INITIALIZE BOTTOM STRESS COEFFICINETS +C + CALL CALTBXY_mpi(ISTL,IS2TL) +C +C**********************************************************************C +C +C ** SET BOTTOM AND SURFACE STRESSES +C +C----------------------------------------------------------------------C +C + DO L=2,LA + TBX(L)=(AVCON1*HUI(L)+STBX(L)*SQRT(VU(L)*VU(L) + & +U(L,1)*U(L,1)))*U(L,1) + TBY(L)=(AVCON1*HVI(L)+STBY(L)*SQRT(UV(L)*UV(L) + & +V(L,1)*V(L,1)))*V(L,1) + ENDDO + CALL broadcast_boundary(TBX,ic) + CALL broadcast_boundary(TBY,ic) +C + N=0 + CALL CALTSXY_mpi +C +C----------------------------------------------------------------------C +C +C ** SET DEPTH DEVIATION FROM UNIFORM FLOW ON FLOW FACES +C + DO L=2,LA + HDFUFX(L)=1. + HDFUFY(L)=1. + HDFUF(L)=1. + ENDDO +C + IF(ISBSDFUF.GE.1)THEN + HDFUFM=1.E-12 +C + DO L=2,LA + LS=LSC(L) + HDFUFX(L)=HDFUFM+G*SUB(L)*HU(L)*(BELV(L-1)-BELV(L))*DXIU(L) + HDFUFY(L)=HDFUFM+G*SVB(L)*HV(L)*(BELV(LS )-BELV(L))*DYIV(L) + ENDDO +C + DO L=2,LA + HDFUFX(L)=TBX(L)/HDFUFX(L) + HDFUFY(L)=TBY(L)/HDFUFY(L) + ENDDO +C + DO L=2,LA + HDFUFX(L)=MAX(HDFUFX(L),-1.0) + HDFUFY(L)=MAX(HDFUFY(L),-1.0) + ENDDO +C + DO L=2,LA + HDFUFX(L)=MIN(HDFUFX(L),1.0) + HDFUFY(L)=MIN(HDFUFY(L),1.0) + ENDDO +C + ENDIF +C +C**********************************************************************C +C +C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED +C +C----------------------------------------------------------------------C +C + IF(ISWAVE.EQ.0)THEN +C +C----------------------------------------------------------------------c +C + IF(ISCORTBC.EQ.0) THEN +C + DO L=2,LA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO +C + DO L=2,LA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + QQ(L,0 )=0.5*CTURB2*SQRT( + & (RSSBCE(L)*TVAR3E(L)+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TVAR3N(L)+RSSBCS(L)*TBY(L))**2) + TAUBSED(L)=QQ(L,0 )/CTURB2 + QQ(L,KC)=0.5*CTURB2*SQRT( + & (RSSBCE(L)*TVAR3W(L)+RSSBCW(L)*TSX(L))**2 + & +(RSSBCN(L)*TVAR3S(L)+RSSBCS(L)*TSY(L))**2) + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO +C + ENDIF +C +C----------------------------------------------------------------------c +C + IF(ISCORTBC.GE.1) THEN +C + IF(DEBUG)THEN + IF(ISCORTBCD.GE.1)THEN + OPEN(1,FILE='ADJSTRESSE.OUT') + CLOSE(1,STATUS='DELETE') + ENDIF +C + OPEN(1,FILE='TBCORINIT.OUT') + ENDIF +C + DO L=2,LA + IF(ISSBCP(L).EQ.0)THEN + IF(SUB(L+1).LT.0.5) WCOREST(L)=FSCORTBCV(L) + IF(SUB(L).LT.0.5) WCORWST(L)=FSCORTBCV(L) + IF(SVB(LNC(L)).LT.0.5) WCORNTH(L)=FSCORTBCV(L) + IF(SVB(L).LT.0.5) WCORSTH(L)=FSCORTBCV(L) + ENDIF + ENDDO +C + DO L=2,LA + WCOREW(L)=1./(WCOREST(L)+WCORWST(L)) + WCORNS(L)=1./(WCORNTH(L)+WCORSTH(L)) + ENDDO +C + DO L=2,LA + WCOREST(L)=WCOREST(L)*WCOREW(L) + WCORWST(L)=WCORWST(L)*WCOREW(L) + WCORNTH(L)=WCORNTH(L)*WCORNS(L) + WCORSTH(L)=WCORSTH(L)*WCORNS(L) + ENDDO +C + DO L=2,LA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO +C + DO L=2,LA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + QQ(L,0 )=CTURB2*SQRT( + & (RSSBCE(L)*WCOREST(L)*TVAR3E(L) + & +RSSBCW(L)*WCORWST(L)*TBX(L))**2 + & +(RSSBCN(L)*WCORNTH(L)*TVAR3N(L) + & +RSSBCS(L)*WCORSTH(L)*TBY(L))**2) + QQ(L,KC)=0.5*CTURB2*SQRT( + & (RSSBCE(L)*TVAR3W(L)+RSSBCW(L)*TSX(L))**2 + & +(RSSBCN(L)*TVAR3S(L)+RSSBCS(L)*TSY(L))**2) + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO +C + DO L=2,LA + TAUBSED(L)=QQ(L,0 )/CTURB2 + TAUBSND(L)=QQ(L,0 )/CTURB2 + ENDDO + + IF(DEBUG)THEN + DO L=2,LA + IF(WCORSTH(L).LT.0.49.OR.WCORSTH(L).GT.0.51)THEN + IF(WCORWST(L).LT.0.49.OR.WCORWST(L).GT.0.51)THEN + WRITE(1,3678)IL(L),JL(L),WCORWST(L),WCOREST(L), + & WCORSTH(L),WCORNTH(L) + ENDIF + ENDIF + ENDDO +C + CLOSE(1) + ENDIF +C + ENDIF +C +C----------------------------------------------------------------------c +C + ENDIF +C +C ENDIF +C +C**********************************************************************C +C +C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED +C +C----------------------------------------------------------------------C +C + IF(ISWAVE.GE.1)THEN +C + DO L=2,LA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO +C + DO L=2,LA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + TAUBC2 = (RSSBCE(L)*TVAR3E(L)+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TVAR3N(L)+RSSBCS(L)*TBY(L))**2 + TAUBC=0.5*SQRT(TAUBC2) + UTMP=0.5*STCUV(L)*(U(L+1,1)+U(L,1))+1.E-12 + VTMP=0.5*STCUV(L)*(V(LN,1)+V(L,1)) + CURANG=ATAN2(VTMP,UTMP) + TAUB2=TAUBC*TAUBC+0.5*(QQWV1(L)*QQWV1(L)) + & +FOURDPI*TAUBC*QQWV1(L)*COS(CURANG-WACCWE(L)) + TAUB2=MAX(TAUB2,0.) + QQ(L,0 )=CTURB2*SQRT(TAUB2) + QQ(L,KC)=0.5*CTURB2*SQRT((TVAR3W(L)+TSX(L))**2 + & +(TVAR3S(L)+TSY(L))**2) + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO +C + ENDIF +C +C ENDIF +C +C**********************************************************************C +C +C ** SET SWITCHES FOR TWO TIME LEVEL INTEGRATION +C + ISTL=2 + IS2TL=1 + DELT=DT + DELTD2=DT/2. + DZDDELT=DZ/DELT +C +C**********************************************************************C +C +C ** BEGIN TIME LOOP FOR FULL HYDRODYNAMIC AND MASS TRANSPORT +C ** CALCULATION +C +C ** SET CYCLE COUNTER AND CALL TIMER +C + NTIMER=0 + ISSREST=0 + NRESTO=ISRESTO*NTSPTC + N=0 +C +C *** EE BEGIN BLOCK +C ** INITIALZE & RECORD TIME +C + TIMEDAY=TCON*TBEGIN/86400. + IF(MYRANK.EQ.0) CALL TIMELOG(0,TIMEDAY) + IF(ISDYNSTP.GT.0)THEN + ! *** ALLOW FOR SEDIMENT RAMPUP + ISAVESEDDT=ISEDDT + ISEDDT=1 + ENDIF +C +C *** EE END BLOCK +C + NTIMER=1 + NINCRMT=1 + NLOOP=0 +C + PRINT_SUM=.FALSE. + IF(PRINT_SUM)THEN + call collect_in_zero(TSX) + call collect_in_zero(TSY) + call collect_in_zero(TBX) + call collect_in_zero(TBY) + call collect_in_zero_array(AV) + call collect_in_zero_array(AB) + call collect_in_zero_array(AQ) + call collect_in_zero(HP) + call collect_in_zero(HU) + call collect_in_zero(HV) + call collect_in_zero(P) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + call collect_in_zero_array(W) + call collect_in_zero_array(TEM) + call collect_in_zero_array(SEDT) + do k=0,kcm + call collect_in_zero(QQ(:,k)) + call collect_in_zero(QQL(:,k)) + enddo + DO NW=1,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, 0,'TSX = ', sum(abs(dble(TSX))) + PRINT*, 0,'TSY = ', sum(abs(dble(TSY))) + PRINT*, 0,'TBX = ', sum(abs(dble(TBX))) + PRINT*, 0,'TBY = ', sum(abs(dble(TBY))) + PRINT*, 0,'AV = ', sum(abs(dble(AV))) + PRINT*, 0,'AB = ', sum(abs(dble(AB))) + PRINT*, 0,'AQ = ', sum(abs(dble(AQ))) + PRINT*, 0,'HP = ', sum(abs(dble(HP))) + PRINT*, 0,'HU = ', sum(abs(dble(HU))) + PRINT*, 0,'HV = ', sum(abs(dble(HV))) + PRINT*, 0,'P = ', sum(abs(dble(P))) + PRINT*, 0,'U = ', sum(abs(dble(U))) + PRINT*, 0,'V = ', sum(abs(dble(V))) + PRINT*, 0,'W = ', sum(abs(dble(W))) + PRINT*, 0,'TEM = ', sum(abs(dble(TEM))) + PRINT*, 0,'SEDT = ', sum(abs(dble(SEDT))) + PRINT*, 0,'QQ = ', sum(abs(dble(QQ))) + PRINT*, 0,'QQL = ', sum(abs(dble(QQL))) + PRINT*, 0,'WQV = ', sum(abs(dble(WQV))) + PRINT*, 0,'WQVX = ', sum(abs(dble(WQVX))) + ENDIF + ENDIF +C----------------------------------------------------------------------C +C + 1001 CONTINUE + IF(N.GE.NTS)GO TO 1000 +C +C ITERATION START + TTIME=MPI_TIC() + STIME=MPI_TIC() + IF(ISDYNSTP.EQ.0)THEN + N=N+1 + ETIMESEC=DT*FLOAT(N) + ETIMEDAY=DT*FLOAT(N)/86400. + TIMESEC=(DT*FLOAT(N)+TCON*TBEGIN) + TIMEDAY=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ELSE + NLOOP=NLOOP+1 + IF(NLOOP.GT.ITRMADJ)THEN + ISEDDT=ISAVESEDDT ! *** PMC-ALLOW FOR SEDIMENT RAMPUP ALSO + IF(IDRYTBP.EQ.0)THEN + CALL CALSTEP + ELSE + CALL CALSTEPD + ENDIF + ELSE + DTDYN=DT + NINCRMT=1 + ENDIF + DELT=DTDYN + DELTD2=DTDYN/2. + DZDDELT=DZ/DTDYN + N=N+NINCRMT + ETIMESEC=DT*FLOAT(N) + ETIMEDAY=(DT*FLOAT(N))/86400. + TIMESEC=(DT*FLOAT(N)+TCON*TBEGIN) + TIMEDAY=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ENDIF +C +C PMC IF(ILOGC.EQ.NTSMMT)THEN + IF(ILOGC.EQ.NTSPTC.AND.MYRANK.EQ.0)THEN + CLOSE(8,STATUS='DELETE') + OPEN(8,FILE='EFDCLOG.OUT',STATUS='UNKNOWN') + IF(DEBUG)THEN + IF(ISDRY.GT.0)THEN + OPEN(1,FILE='DRYWET.LOG',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + IF(ISCFL.EQ.1)THEN + OPEN(1,FILE='CFL.OUT',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + ENDIF + ENDIF + ILOGC=0 + ENDIF +C + IF(ISDYNSTP.EQ.0)THEN + ILOGC=ILOGC+1 + ELSE + ILOGC=ILOGC+NINCRMT + ENDIF +C +C *** DSLLC BEGIN BLOCK + IF(N.LE.NLTS)THEN + SNLT=0. + ELSEIF(N.GT.NLTS.AND.N.LE.NTTS)THEN + NTMP1=N-NLTS + NTMP2=NTTS-NLTS+1 + SNLT=FLOAT(NTMP1)/FLOAT(NTMP2) + ELSE + SNLT=1. + ENDIF + + ! *** TURN OFF WIND SHELTERING FOR ICE CONDITIONS (TO BE REPLACED AFTER FULL ICE SUBMODEL ADDED) + IF(WINTER_END > WINTER_START)THEN + IF(TIMEDAY > WINTER_START)THEN + IF(WINDSTKA_SAVE(1)==0.)THEN + ! *** TOGGLE OFF THE WIND SHELTERING COEFFICIENTS + DO L=2,LA + WINDSTKA_SAVE(L)=WINDSTKA(L) + WINDSTKA(L)=0. + ENDDO + WINDSTKA_SAVE(1) = 1. + ENDIF + IF(TIMEDAY > WINTER_END)THEN + ! *** TOGGLE ON THE WIND SHELTERING COEFFICIENTS + DO L=2,LA + WINDSTKA(L) = WINDSTKA_SAVE(L) + ENDDO + WINDSTKA_SAVE(1) = 0. + WINTER_START = WINTER_START+365. + WINTER_END = WINTER_END+365. + ENDIF + ENDIF + ENDIF +C *** DSLLC END BLOCK +C + IF(N.LE.NTSVB)THEN + GP=GPO*(FLOAT(N)/FLOAT(NTSVB)) + ELSE + GP=GPO + ENDIF +C + MPI_WTIMES(2)=MPI_WTIMES(2)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +C ** INITIALIZE TWO-TIME LEVEL BALANCES +C + STIME=MPI_TIC() +C + IF(IS2TIM.GE.1) THEN + IF(ISBAL.GE.1)THEN + CALL BAL2T1 + ENDIF + ENDIF +C + MPI_WTIMES(3)=MPI_WTIMES(3)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +C ** REENTER HERE FOR TWO TIME LEVEL LOOP +C +C 500 CONTINUE +C +C**********************************************************************C +C +C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) +C + STIME=MPI_TIC() +C + IF(KC.GT.1)THEN + IF(ISQQ.EQ.1)THEN + IF(MYRANK.EQ.0)THEN + ENDIF + IF(ISTOPT(0).EQ.0)CALL CALAVBOLD_mpi (ISTL) + IF(ISTOPT(0).GE.1)CALL CALAVB_mpi (ISTL) + ENDIF + IF(MYRANK.EQ.0)THEN + ENDIF + IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) + ENDIF +C + IF(.FALSE.)THEN + call collect_in_zero_array(AVUI) + call collect_in_zero_array(AVVI) + call collect_in_zero_array(AV ) + call collect_in_zero_array(AB ) + call collect_in_zero_array(AQ ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'AVUI = ', sum(abs(dble(AVUI ))) + PRINT*, n,'AVVI = ', sum(abs(dble(AVVI ))) + PRINT*, n,'AV = ', sum(abs(dble(AV ))) + PRINT*, n,'AB = ', sum(abs(dble(AB ))) + PRINT*, n,'AQ = ', sum(abs(dble(AQ ))) + ENDIF + ENDIF +C + MPI_WTIMES(4)=MPI_WTIMES(4)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE WAVE BOUNDARY LAYER AND WAVE REYNOLDS STRESS FORCINGS +C + STIME=MPI_TIC() +C + IF(ISWAVE.EQ.1) CALL WAVEBL + IF(ISWAVE.EQ.2) CALL WAVESXY + IF(ISWAVE.EQ.3.AND.NWSER > 0) CALL WINDWAVETUR !DHC NEXT CALL +C + MPI_WTIMES(5)=MPI_WTIMES(5)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** ADVANCE TIME VARIABLE SURFACE WIND STRESS AND UPDATE NEW WIND +C ** STRESSES *** DSLLC MOVED +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + CALL CALTSXY_mpi +C + IF(.FALSE.)THEN + call collect_in_zero(TSX ) + call collect_in_zero(TSY ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'TSX = ', sum(abs(dble(TSX ))) + PRINT*, n,'TSY = ', sum(abs(dble(TSY ))) + ENDIF + ENDIF +C + MPI_WTIMES(6)=MPI_WTIMES(6)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE EXPLICIT MOMENTUM EQUATION TERMS +C + STIME=MPI_TIC() +C + IF(IS2TIM.EQ.1) CALL CALEXP2T_mpi + IF(IS2TIM.EQ.2) CALL CALIMP2T +C + IF(.FALSE.)THEN + call collect_in_zero(FCAXE) + call collect_in_zero(FCAYE) + call collect_in_zero(FXE ) + call collect_in_zero(FYE ) + call collect_in_zero_array(FX ) + call collect_in_zero_array(FY ) + call collect_in_zero_array(FBBX) + call collect_in_zero_array(FBBY) + call collect_in_zero_array(DU ) + call collect_in_zero_array(DV ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'FCAXE = ', sum(abs(dble(FCAXE))) + PRINT*, n,'FCAYE = ', sum(abs(dble(FCAYE))) + PRINT*, n,'FXE = ', sum(abs(dble(FXE ))) + PRINT*, n,'FYE = ', sum(abs(dble(FYE ))) + PRINT*, n,'FX = ', sum(abs(dble(FX ))) + PRINT*, n,'FY = ', sum(abs(dble(FY ))) + PRINT*, n,'FBBX = ', sum(abs(dble(FBBX ))) + PRINT*, n,'FBBY = ', sum(abs(dble(FBBY ))) + PRINT*, n,'DU = ', sum(abs(dble(DU ))) + PRINT*, n,'DV = ', sum(abs(dble(DV ))) + ENDIF + ENDIF + MPI_WTIMES(7)=MPI_WTIMES(7)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** UPDATE TIME VARIABLE VOLUME SOURCES AND SINKS, CONCENTRATIONS, +C ** VEGETATION CHARACTERISTICS AND SURFACE ELEVATIONS +C + STIME=MPI_TIC() +C + CALL CALCSER_mpi (ISTL) + CALL CALVEGSER_mpi (ISTL) + CALL CALQVS_mpi (ISTL) + PSERT(0)=0. + IF(NPSER.GE.1) CALL CALPSER_mpi (ISTL) +C + MPI_WTIMES(8)=MPI_WTIMES(8)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE +C + STIME=MPI_TIC() +C + IF(ISCHAN.EQ.0.AND.ISDRY.EQ.0) CALL CALPUV2T + IF(ISCHAN.GE.1.OR.ISDRY.GE.1) CALL CALPUV2C_mpi +C + MPI_WTIMES(9)=MPI_WTIMES(9)+MPI_TOC(STIME) +C + IF(.FALSE.)THEN + call collect_in_zero(UHDYE) + call collect_in_zero(VHDXE) + call collect_in_zero(HU ) + call collect_in_zero(HV ) + call collect_in_zero(P ) + call collect_in_zero(TBX ) + call collect_in_zero(TBY ) + call collect_in_zero(FCAXE) + call collect_in_zero(FCAYE) + call collect_in_zero(FPGXE) + call collect_in_zero(FPGYE) + call collect_in_zero(FXE ) + call collect_in_zero(FYE ) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'UHDYE = ', sum(abs(dble(UHDYE))) + PRINT*, n,'VHDXE = ', sum(abs(dble(VHDXE))) + PRINT*, n,'HU = ', sum(abs(dble(HU ))) + PRINT*, n,'HV = ', sum(abs(dble(HV ))) + PRINT*, n,'P = ', sum(abs(dble(P ))) + PRINT*, n,'TBX = ', sum(abs(dble(TBX ))) + PRINT*, n,'TBY = ', sum(abs(dble(TBY ))) + PRINT*, n,'FCAXE = ', sum(abs(dble(FCAXE))) + PRINT*, n,'FCAYE = ', sum(abs(dble(FCAYE))) + PRINT*, n,'FPGXE = ', sum(abs(dble(FPGXE))) + PRINT*, n,'FPGYE = ', sum(abs(dble(FPGYE))) + PRINT*, n,'FXE = ', sum(abs(dble(FXE ))) + PRINT*, n,'FYE = ', sum(abs(dble(FYE ))) + ENDIF + ENDIF +C + STIME=MPI_TIC() + CALL MPI_MASKDRY + MPI_WTIMES(62)=MPI_WTIMES(62)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** WRITE DIAGNOSTICS +C +C----------------------------------------------------------------------C +C +C ** DTIME AND FLUSH ARE SUPPORTED ON SUN SYSTEMS, BUT MAY NOT BE +C ** SUPPORTED ON OTHER SYSTEMS. +C + STIME=MPI_TIC() +C + IF(ISLOG.GE.1.AND.MYRANK.EQ.0)THEN + WRITE(8,17)N,ITER,RSQ,CFMAX,AVMAX,ABMIN,ABMAX,ABMIN + ENDIF +C + 17 FORMAT(' N,ITER,RSQ,CFMAX,AVMAX,AVMIN,ABMAX,ABMIN', + & I7,I5,2E12.4,4(1X,F8.4)) +C + ERRMAX=MAX(ERRMAX,ERR) + ERRMIN=MIN(ERRMIN,ERR) + ITRMAX=MAX(ITRMAX,ITER) + IRRMIN=MIN(ITRMIN,ITER) +C + MPI_WTIMES(48)=MPI_WTIMES(48)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** ADVANCE INTERNAL VARIABLES +C +C----------------------------------------------------------------------C + STIME=MPI_TIC() + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + MPI_WTIMES(63)=MPI_WTIMES(63)+MPI_TOC(STIME) +C + STIME=MPI_TIC() +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY2(L,K)=UHDY1(L,K) + UHDY1(L,K)=UHDY(L,K) + VHDX2(L,K)=VHDX1(L,K) + VHDX1(L,K)=VHDX(L,K) + U2(L,K)=U1(L,K) + V2(L,K)=V1(L,K) + U1(L,K)=U(L,K) + V1(L,K)=V(L,K) + W2(L,K)=W1(L,K) + W1(L,K)=W(L,K) + ENDDO + ENDDO +C + MPI_WTIMES(10)=MPI_WTIMES(10)+MPI_TOC(STIME) +C + STIME=MPI_TIC() + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + MPI_WTIMES(61)=MPI_WTIMES(61)+MPI_TOC(STIME) + STIME=MPI_TIC() + call broadcast_boundary_array(UHDY2,IC) + call broadcast_boundary_array(UHDY1,IC) + MPI_WTIMES(51)=MPI_WTIMES(51)+MPI_TOC(STIME) + STIME=MPI_TIC() + call broadcast_boundary_array(VHDX2,IC) + call broadcast_boundary_array(VHDX1,IC) + MPI_WTIMES(52)=MPI_WTIMES(52)+MPI_TOC(STIME) + STIME=MPI_TIC() + call broadcast_boundary_array(U2,IC) + call broadcast_boundary_array(V2,IC) + MPI_WTIMES(53)=MPI_WTIMES(53)+MPI_TOC(STIME) + STIME=MPI_TIC() + call broadcast_boundary_array(U1,IC) + call broadcast_boundary_array(V1,IC) + MPI_WTIMES(54)=MPI_WTIMES(54)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + IF(KC.GT.1)THEN + CALL CALUVW_mpi (ISTL,IS2TL) + ELSE +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDY(L,1)=UHDYE(L) + U(L,1)=UHDYE(L)*HUI(L)*DYIU(L) + VHDX(L,1)=VHDXE(L) + V(L,1)=VHDXE(L)*HVI(L)*DXIV(L) + W(L,1)=0. + ENDDO + CALL CALUVW_mpi (ISTL,IS2TL) + ENDIF + call broadcast_boundary_array(U,ic) + call broadcast_boundary_array(V,ic) +C + MPI_WTIMES(11)=MPI_WTIMES(11)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE SALINITY, TEMPERATURE, DYE AND SEDIMENT CONCENTRATIONS +C ** AT TIME LEVEL (N+1) +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() + CALL CALCONC_mpi (ISTL,IS2TL) + MPI_WTIMES(12)=MPI_WTIMES(12)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +C + ! *** PMC BYPASS IF NOT SIMULATING SEDIMENTS + STIME=MPI_TIC() +C + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + S1TIME=MPI_TIC() + DO K=1,KB +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDBT(L,K)=0. + SNDBT(L,K)=0. + ENDDO + ENDDO + MPI_WTIMES(551)=MPI_WTIMES(551)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO NS=1,NSED + DO K=1,KB +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDBT(L,K)=SEDBT(L,K)+SEDB(L,K,NS) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(552)=MPI_WTIMES(552)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO NS=1,NSND + DO K=1,KB +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SNDBT(L,K)=SNDBT(L,K)+SNDB(L,K,NS) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(553)=MPI_WTIMES(553)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDT(L,K)=0. + SNDT(L,K)=0. + ENDDO + ENDDO + MPI_WTIMES(554)=MPI_WTIMES(554)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO NS=1,NSED + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SEDT(L,K)=SEDT(L,K)+SED(L,K,NS) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(555)=MPI_WTIMES(555)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + DO NS=1,NSND + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + SNDT(L,K)=SNDT(L,K)+SND(L,K,NS) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(556)=MPI_WTIMES(556)+MPI_TOC(S1TIME) + ENDIF +C + MPI_WTIMES(13)=MPI_WTIMES(13)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +C ** CHECK RANGE OF SALINITY AND DYE CONCENTRATION +C + STIME=MPI_TIC() +C + IF(ISMMC.EQ.1)THEN +C + SALMAX=-100000. + SALMIN=100000. + DO K=1,KC + DO L=2,LA + IF(SAL(L,K).GT.SALMAX)THEN + SALMAX=SAL(L,K) + IMAX=IL(L) + JMAX=JL(L) + KMAX=K + ENDIF + IF(SAL(L,K).LT.SALMIN)THEN + SALMIN=SAL(L,K) + IMIN=IL(L) + JMIN=JL(L) + KMIN=K + ENDIF + ENDDO + ENDDO +C + IF(MYRANK.EQ.0) WRITE(6,6001)N + IF(MYRANK.EQ.0) WRITE(6,6002)SALMAX,IMAX,JMAX,KMAX + IF(MYRANK.EQ.0) WRITE(6,6003)SALMIN,IMIN,JMIN,KMIN +C + SALMAX=-100000. + SALMIN=100000. + DO K=1,KC + DO L=2,LA + IF(DYE(L,K).GT.SALMAX)THEN + SALMAX=DYE(L,K) + IMAX=IL(L) + JMAX=JL(L) + KMAX=K + ENDIF + IF(DYE(L,K).LT.SALMIN)THEN + SALMIN=DYE(L,K) + IMIN=IL(L) + JMIN=JL(L) + KMIN=K + ENDIF + ENDDO + ENDDO +C + IF(MYRANK.EQ.0) WRITE(6,6004)SALMAX,IMAX,JMAX,KMAX + IF(MYRANK.EQ.0) WRITE(6,6005)SALMIN,IMIN,JMIN,KMIN +C + IF(MYRANK.EQ.0) WRITE(8,6004)SALMAX,IMAX,JMAX,KMAX + IF(MYRANK.EQ.0) WRITE(8,6005)SALMIN,IMIN,JMIN,KMIN +C + SALMAX=-100000. + SALMIN=100000. + DO K=1,KC + DO L=2,LA + IF(SFL(L,K).GT.SALMAX)THEN + SALMAX=SFL(L,K) + IMAX=IL(L) + JMAX=JL(L) + KMAX=K + ENDIF + IF(SFL(L,K).LT.SALMIN)THEN + SALMIN=SFL(L,K) + IMIN=IL(L) + JMIN=JL(L) + KMIN=K + ENDIF + ENDDO + ENDDO +C + WRITE(6,6006)SALMAX,IMAX,JMAX,KMAX + WRITE(6,6007)SALMIN,IMIN,JMIN,KMIN +C + ENDIF +C +C + IF(ISMMC.EQ.2)THEN +C + SALMAX=-100000. + SALMIN=100000. + DO K=1,KC + DO L=2,LA + IF(TEM(L,K).GT.SALMAX)THEN + SALMAX=TEM(L,K) + IMAX=IL(L) + JMAX=JL(L) + KMAX=K + ENDIF + IF(TEM(L,K).LT.SALMIN)THEN + SALMIN=TEM(L,K) + IMIN=IL(L) + JMIN=JL(L) + KMIN=K + ENDIF + ENDDO + ENDDO +C + WRITE(6,6001)N + WRITE(6,6008)SALMAX,IMAX,JMAX,KMAX + WRITE(6,6009)SALMIN,IMIN,JMIN,KMIN +C + ENDIF +C + MPI_WTIMES(14)=MPI_WTIMES(14)+MPI_TOC(STIME) +C + 6001 FORMAT(' N=',I10) + 6002 FORMAT(' SALMAX=',F14.4,5X,'I,J,K=',(3I10)) + 6003 FORMAT(' SALMIN=',F14.4,5X,'I,J,K=',(3I10)) + 6004 FORMAT(' DYEMAX=',F14.4,5X,'I,J,K=',(3I10)) + 6005 FORMAT(' DYEMIN=',F14.4,5X,'I,J,K=',(3I10)) + 6006 FORMAT(' SFLMAX=',F14.4,5X,'I,J,K=',(3I10)) + 6007 FORMAT(' SFLMIN=',F14.4,5X,'I,J,K=',(3I10)) + 6008 FORMAT(' TEMMAX=',F14.4,5X,'I,J,K=',(3I10)) + 6009 FORMAT(' TEMMIN=',F14.4,5X,'I,J,K=',(3I10)) + + STIME=MPI_TIC() + ! *** DSLLC + IF(DEBUG.AND.MYRANK.EQ.-1)THEN + S1TIME=MPI_TIC() + BTEST=.FALSE. + LTEST=.FALSE. + DO L=2,LA + IF(ISNAN(HP(L)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN DEPTH VARIABLES' + ENDIF + WRITE(1,910) TIMEDAY, L, IL(L), JL(L), + & HP(L),H1P(L) + HP(L)=H1P(L) + LTEST=.TRUE. + ENDIF + ENDDO + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(571)=MPI_WTIMES(571)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(KC.GT.1)THEN + DO L=2,LA + DO K=1,KC + IF(ISNAN(AV(L,K)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN VERTICAL VISCOSITY' + ENDIF + WRITE(1,9101) TIMEDAY, L, IL(L), JL(L), K, 'AV ', + & AV(L,K) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(572)=MPI_WTIMES(572)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(1).GE.1)THEN + DO L=2,LA + DO K=1,KC + IF(ISNAN(SAL(L,K)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN SALINITY VARIABLES' + ENDIF + WRITE(1,911) TIMEDAY, L, IL(L), JL(L), K, + & SAL(L,K),SAL1(L,K) + SAL(L,K)=SAL1(L,K) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(573)=MPI_WTIMES(573)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(2).GE.1)THEN + DO L=2,LA + DO K=1,KC + IF(ISNAN(TEM(L,K)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN TEMPERATURE VARIABLES' + ENDIF + WRITE(1,912) TIMEDAY, L, IL(L), JL(L), K, + & TEM(L,K),TEM1(L,K) + TEM(L,K)=TEM1(L,K) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(574)=MPI_WTIMES(574)+MPI_TOC(S1TIME) + +!{ GEOSR 2012.8.30 jgcho + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(3).GE.1)THEN + DO L=2,LA + DO K=1,KC + IF(ISNAN(DYE(L,K)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN DYE VARIABLES' + ENDIF + WRITE(1,912) TIMEDAY, L, IL(L), JL(L), K, + & DYE(L,K),DYE1(L,K) + DYE(L,K)=DYE1(L,K) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(575)=MPI_WTIMES(575)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(6).GE.1)THEN + ERRTEST=.FALSE. + DO NS=1,NSED + DO K=1,KC + DO L=LMPI2,LMPILA + IF(ISNAN(SED(L,K,NS)))THEN + ERRTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDDO + CALL MPI_ALLREDUCE(ERRTEST,MPI_LG,1,MPI_LOGICAL,MPI_LOR, + & MPI_COMM_WORLD,IERR) + ERRTEST=MPI_LG + IF(ERRTEST)THEN + DO NS=1,NSED + DO K=1,KC + DO L=2,LA + IF(ISNAN(SED(L,K,NS)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN SED VARIABLES' + ENDIF + WRITE(1,916) TIMEDAY, L, IL(L), JL(L), K, NS, + & SED(L,K,NS),SED1(L,K,NS) + SED(L,K,NS)=SED1(L,K,NS) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(577)=MPI_WTIMES(577)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(7).GE.1)THEN + DO L=2,LA + DO K=1,KC + DO NS=1,NSND + IF(ISNAN(SND(L,K,NS)))THEN + BTEST=.TRUE. + IF(.NOT.LTEST)THEN + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN SAND VARIABLES' + ENDIF + WRITE(1,917) TIMEDAY, L, IL(L), JL(L), K, NS, + & SND(L,K,NS),SND(L,K,NS) + SND(L,K,NS)=SND1(L,K,NS) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(577)=MPI_WTIMES(577)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + LTEST=.FALSE. + IF(ISTRAN(8).GE.1)THEN + ERRTEST=.FALSE. + DO NW=1,21 + DO K=1,KC + DO L=LMPI2,LMPILA + IF(ISNAN(WQV(L,K,NW)))THEN + ERRTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDDO + CALL MPI_ALLREDUCE(ERRTEST,MPI_LG,1,MPI_LOGICAL,MPI_LOR, + & MPI_COMM_WORLD,IERR) + ERRTEST=MPI_LG + IF(ERRTEST)THEN + DO NW=1,21 + DO K=1,KC + DO L=2,LA + IF(ISNAN(WQV(L,K,NW)))THEN + BTEST=.TRUE. + OPEN(1,FILE='ERROR.LOG',POSITION='APPEND', + & STATUS='UNKNOWN') + WRITE(1,*)' * DEBUG: ERROR IN WATER QUALITY VARIABLES' + WRITE(1,918) TIMEDAY, L, IL(L), JL(L), K, NW, + & WQV(L,K,NW),WQVO(L,K,NW) + CLOSE(1,STATUS='KEEP') + WQV(L,K,NW)=WQVO(L,K,NW) + LTEST=.TRUE. + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF + IF(LTEST)CLOSE(1,STATUS='KEEP') + MPI_WTIMES(579)=MPI_WTIMES(579)+MPI_TOC(S1TIME) + ENDIF + + 910 FORMAT('ERROR: TIME, L, I, J, HP = ', F10.5,3I6,2F10.4) + 9101 FORMAT('ERROR: TIME, L, I, J, K, ',A3,' = ', F10.5,4I6,2F10.4) + 911 FORMAT('ERROR: TIME, L, I, J, K, SAL = ', F10.5,4I6,2F10.4) + 912 FORMAT('ERROR: TIME, L, I, J, K, TEM = ', F10.5,4I6,2F10.4) + 916 FORMAT('ERROR: TIME, L, I, J, K, NS, SED = ',F10.5,5I6,2F10.4) + 917 FORMAT('ERROR: TIME, L, I, J, K, NX, SND = ',F10.5,5I6,2F10.4) + 918 FORMAT('ERROR: TIME, L, I, J, K, NW, WQV = ',F10.5,5I6,2F10.4) + + ! *** DUMP THE RESULTS (JUST PRIOR) TO EE FOR ANALYSIS + IF(DEBUG.AND.MYRANK.EQ.-1)THEN + S1TIME=MPI_TIC() + IF(BTEST)THEN + CALL SURFPLT + CALL VELPLTH_mpi + CALL EEXPOUT_mpi(-1) + CLOSE(7) + CLOSE(8) + CLOSE(9) + STOP 'ERROR: NANs have been computed!' + ENDIF + MPI_WTIMES(580)=MPI_WTIMES(580)+MPI_TOC(S1TIME) + ENDIF +C + MPI_WTIMES(15)=MPI_WTIMES(15)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE SHELL FISH LARVAE AND/OR WATER QUALITY CONSTITUENT +C ** CONCENTRATIONS AT TIME LEVEL (N+1) AFTER SETTING DOUBLE TIME +C ** STEP TRANSPORT FIELD +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + ITMP=0 + IF(ISTRAN(4).GE.1) ITMP=1 + IF(ISTRAN(8).GE.1) ITMP=1 + IF(ISWASP.GE.1)ITMP=1 ! 6/7/2005 a stoddard dsllc + IF(ISICM.GE.1) ITMP=1 +C + IF(ITMP.EQ.1)THEN +C +C ** CALCULATE CONSERVATION OF VOLUME FOR THE WATER QUALITY ADVECTION +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HWQ(L)=HP(L) + WWQ(L,0)=0. + ENDDO +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + UHDYWQ(L,K)=UHDY2(L,K) + VHDXWQ(L,K)=VHDX2(L,K) + UWQ(L,K)=U2(L,K) + VWQ(L,K)=V2(L,K) + WWQ(L,K)=W2(L,K) + ENDDO + ENDDO +C +C ADD CHANNEL INTERACTIONS +C + + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + IF(MDCHTYP(NMD).EQ.1)THEN + HWQ(LMDCHH(NMD))=HWQ(LMDCHH(NMD)) + & +DT2*DXYIP(LMDCHH(NMD))*(QCHANU(NMD)) + HWQ(LMDCHU(NMD))=HWQ(LMDCHU(NMD)) + & -DT2*DXYIP(LMDCHU(NMD))*(QCHANU(NMD)) + ENDIF + IF(MDCHTYP(NMD).EQ.2)THEN + HWQ(LMDCHH(NMD))=HWQ(LMDCHH(NMD)) + & +DT2*DXYIP(LMDCHH(NMD))*(QCHANV(NMD)) + HWQ(LMDCHV(NMD))=HWQ(LMDCHV(NMD)) + & -DT2*DXYIP(LMDCHV(NMD))*(QCHANV(NMD)) + ENDIF + IF(MDCHTYP(NMD).EQ.3)THEN + HWQ(LMDCHH(NMD))=HWQ(LMDCHH(NMD)) + & +DT2*DXYIP(LMDCHH(NMD))*(QCHANU(NMD)) + & +DT2*DXYIP(LMDCHH(NMD))*(QCHANV(NMD)) + HWQ(LMDCHU(NMD))=HWQ(LMDCHU(NMD)) + & -DT2*DXYIP(LMDCHU(NMD))*(QCHANU(NMD)) + HWQ(LMDCHV(NMD))=HWQ(LMDCHV(NMD)) + & -DT2*DXYIP(LMDCHV(NMD))*(QCHANV(NMD)) + ENDIF + ENDDO + ENDIF +C +C END ADD CHANNEL INTERACTIONS +C + IF(ISTRAN(8).GE.1) CALL WQ3D_mpi(ISTL,IS2TL) +C + IF(ISTRAN(4).GE.1) CALL CALSFT_mpi(ISTL,IS2TL) +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + H2WQ(L)=HWQ(L) + ENDDO +C + ENDIF +C + MPI_WTIMES(16)=MPI_WTIMES(16)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** UPDATE BUOYANCY AND CALCULATE NEW BUOYANCY USING +C ** AN EQUATION OF STATE +C + STIME=MPI_TIC() +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B1(L,K)=B(L,K) + ENDDO + ENDDO +C + IF(BSC.GT.1.E-6)THEN + CALL CALBUOY_mpi + ELSE + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + B(L,K)=0. + ENDDO + ENDDO + ENDIF +C + MPI_WTIMES(17)=MPI_WTIMES(17)+MPI_TOC(STIME) +C + STIME=MPI_TIC() + CALL broadcast_boundary_array(B1,ic) + CALL broadcast_boundary_array(B,ic) + MPI_WTIMES(55)=MPI_WTIMES(55)+MPI_TOC(STIME) +C +C +C ** CALL TWO-TIME LEVEL BALANCES +C + STIME=MPI_TIC() +C + IF(ISBAL.GE.1)THEN + CALL BAL2T4 + ENDIF +C + MPI_WTIMES(18)=MPI_WTIMES(18)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE U AT V AND V AT U AT TIME LEVEL (N+1) +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C +!$OMP PARALLEL DO PRIVATE(LN,LS,LNW,LSE,LSW) + DO L=LMPI2,LMPILA + LN=LNC(L) + LS=LSC(L) + LNW=LNWC(L) + LSE=LSEC(L) + LSW=LSWC(L) + U1V(L)=UV(L) + V1U(L)=VU(L) + UV(L)=0.25*(HP(LS)*(U(LSE,1)+U(LS,1)) + & +HP(L)*(U(L+1,1)+U(L,1)))*HVI(L) + VU(L)=0.25*(HP(L-1)*(V(LNW,1)+V(L-1,1)) + & +HP(L)*(V(LN,1)+V(L,1)))*HUI(L) + ENDDO +C + MPI_WTIMES(19)=MPI_WTIMES(19)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE HORIZONTAL VISCOSITY AND MOMENTUM DIFFUSION FLUXES +C ** AT TIME LEVEL (N) +C + STIME=MPI_TIC() +C + IF(ISHDMF.GE.1) CALL CALHDMF_mpi +C + MPI_WTIMES(20)=MPI_WTIMES(20)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE BOTTOM STRESS AT LEVEL (N+1) +C + STIME=MPI_TIC() +C + CALL CALTBXY_mpi(ISTL,IS2TL) +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TBX(L)=(AVCON1*HUI(L)+STBX(L)*SQRT(VU(L)*VU(L) + & +U(L,1)*U(L,1)))*U(L,1) + TBY(L)=(AVCON1*HVI(L)+STBY(L)*SQRT(UV(L)*UV(L) + & +V(L,1)*V(L,1)))*V(L,1) + ENDDO + MPI_WTIMES(21)=MPI_WTIMES(21)+MPI_TOC(STIME) +C + STIME=MPI_TIC() + CALL broadcast_boundary(TBX,ic) + CALL broadcast_boundary(TBY,ic) + MPI_WTIMES(56)=MPI_WTIMES(56)+MPI_TOC(STIME) +C +C +C**********************************************************************C +C +C ** SET DEPTH DEVIATION FROM UNIFORM FLOW ON FLOW FACES +C + STIME=MPI_TIC() +C + IF(ISBSDFUF.GE.1)THEN + HDFUFM=1.E-12 +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + LS=LSC(L) + HDFUFX(L)=HDFUFM+G*SUB(L)*HU(L)*(BELV(L-1)-BELV(L))*DXIU(L) + HDFUFY(L)=HDFUFM+G*SVB(L)*HV(L)*(BELV(LS )-BELV(L))*DYIV(L) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HDFUFX(L)=TBX(L)/HDFUFX(L) + HDFUFY(L)=TBY(L)/HDFUFY(L) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HDFUFX(L)=MAX(HDFUFX(L),-1.0) + HDFUFY(L)=MAX(HDFUFY(L),-1.0) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + HDFUFX(L)=MIN(HDFUFX(L),1.0) + HDFUFY(L)=MIN(HDFUFY(L),1.0) + ENDDO +C + ENDIF +C + MPI_WTIMES(22)=MPI_WTIMES(22)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED AT (N+1) +C +C----------------------------------------------------------------------C +C +C + IF(ISWAVE.EQ.0)THEN +C +C +C----------------------------------------------------------------------c +C + IF(ISCORTBC.EQ.0) THEN +C + STIME=MPI_TIC() + S1TIME=MPI_TIC() +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO + MPI_WTIMES(891)=MPI_WTIMES(891)+MPI_TOC(S1TIME) +C + S1TIME=MPI_TIC() +!$OMP PARALLEL DO PRIVATE(TMP) + DO L=LMPI2,LMPILA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + TMP = (RSSBCE(L)*TVAR3E(L)+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TVAR3N(L)+RSSBCS(L)*TBY(L))**2 + QQ(L,0 )=0.5*CTURB2*SQRT(TMP) + + TMP = (RSSBCE(L)*TVAR3W(L)+RSSBCW(L)*TSX(L))**2 + & +(RSSBCN(L)*TVAR3S(L)+RSSBCS(L)*TSY(L))**2 + QQ(L,KC)=0.5*CTURB2*SQRT(TMP) + + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO + MPI_WTIMES(892)=MPI_WTIMES(892)+MPI_TOC(S1TIME) + MPI_WTIMES(23)=MPI_WTIMES(23)+MPI_TOC(STIME) +C + ENDIF +C +C----------------------------------------------------------------------c +C + STIME=MPI_TIC() +C + IF(ISCORTBC.GE.1) THEN +C + IF(ISCORTBCD.GE.1)THEN + NTMPVAL=MOD(N,NTSPTC) + IF(NTMPVAL.EQ.0.AND.DEBUG)THEN + OPEN(1,FILE='ADJSTRESSE.OUT',ACCESS='APPEND') + ENDIF + ENDIF +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WCOREST(L)=1. + WCORWST(L)=1. + WCORNTH(L)=1. + WCORSTH(L)=1. + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(ISSBCP(L).EQ.0)THEN + IF(SUB(L+1).LT.0.5)WCOREST(L)=FSCORTBCV(L) + IF(SUB(L).LT.0.5)WCORWST(L)=FSCORTBCV(L) + IF(SVB(LNC(L)).LT.0.5)WCORNTH(L)=FSCORTBCV(L) + IF(SVB(L).LT.0.5)WCORSTH(L)=FSCORTBCV(L) + ENDIF + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WCOREW(L)=1./(WCOREST(L)+WCORWST(L)) + WCORNS(L)=1./(WCORNTH(L)+WCORSTH(L)) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WCOREST(L)=WCOREST(L)*WCOREW(L) + WCORWST(L)=WCORWST(L)*WCOREW(L) + WCORNTH(L)=WCORNTH(L)*WCORNS(L) + WCORSTH(L)=WCORSTH(L)*WCORNS(L) + ENDDO +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + QQ(L,0 )=CTURB2*SQRT( + & (RSSBCE(L)*WCOREST(L)*TVAR3E(L) + & +RSSBCW(L)*WCORWST(L)*TBX(L))**2 + & +(RSSBCN(L)*WCORNTH(L)*TVAR3N(L) + & +RSSBCS(L)*WCORSTH(L)*TBY(L))**2) + QQ(L,KC)=0.5*CTURB2*SQRT( + & (RSSBCE(L)*TVAR3W(L)+RSSBCW(L)*TSX(L))**2 + & +(RSSBCN(L)*TVAR3S(L)+RSSBCS(L)*TSY(L))**2) + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO +C + IF(ISCORTBCD.GE.1.AND.NTMPVAL.EQ.0)THEN +C +!$OMP PARALLEL DO PRIVATE(KCORNER) + DO L=LMPI2,LMPILA + LCORNER(L)=0 + KCORNER=0 + IF(WCORWST(L).GT.0.505)THEN + KCORNER=KCORNER+1 + LCORNWE(L)=L-1 + ENDIF + IF(WCOREST(L).GT.0.505)THEN + KCORNER=KCORNER+1 + LCORNWE(L)=L+1 + ENDIF + IF(WCORNTH(L).GT.0.505)THEN + KCORNER=KCORNER+1 + LCORNSN(L)=LNC(L) + ENDIF + IF(WCORSTH(L).GT.0.505)THEN + KCORNER=KCORNER+1 + LCORNSN(L)=LSC(L) + ENDIF + IF(KCORNER.EQ.2)LCORNER(L)=1 + ENDDO +C + NCORCELLS=0 +!$OMP PARALLEL DO REDUCTION(+:NCORCELLS) + DO L=LMPI2,LMPILA + NCORCELLS=NCORCELLS+LCORNER(L) + ENDDO + CALL MPI_ALLREDUCE(NCORCELLS,MPI_I4,1,MPI_INT,MPI_SUM, + & MPI_COMM_WORLD,IERR) + NCORCELLS=MPI_I4 +C + IF(DEBUG.AND.MYRANK.EQ.0)THEN + WRITE(1,3675)TIMEDAY,NCORCELLS + DO L=2,LA + IF(LMASKDRY(L))THEN + IF(LCORNER(L).EQ.1)THEN + LWE=LCORNWE(L) + LSN=LCORNSN(L) + TAUTMP=QQ(L,0)/CTURB2 + TAUTMPWE=QQ(LWE,0)/CTURB2 + TAUTMPSN=QQ(LSN,0)/CTURB2 + WRITE(1,3677)IL(L),JL(L),TAUTMP,TAUBSND(L), + & TAUBSED(L) + WRITE(1,3676)IL(LWE),JL(LWE),TAUTMPWE,TAUBSND(LWE), + & TAUBSED(LWE) + WRITE(1,3676)IL(LSN),JL(LSN),TAUTMPSN,TAUBSND(LSN), + & TAUBSED(LSN) + ENDIF + ENDIF + ENDDO + ENDIF +C + ENDIF + + IF(DEBUG)CLOSE(1) +C + ENDIF +C +C----------------------------------------------------------------------c +C + ENDIF +C + MPI_WTIMES(25)=MPI_WTIMES(25)+MPI_TOC(STIME) +C + 3678 FORMAT(2I6,4F13.3) +C3679 FORMAT(12x,4F13.3) +C3680 FORMAT(12x,6F13.5) +C3681 FORMAT(12X,5E13.4,F13.5) + 3677 FORMAT('CORNER',2I5,5E14.5) + 3676 FORMAT(6X,2I5,5E14.5) + 3675 FORMAT(F11.3,I6,' TIME IN DAYS AND NUMBER OF CORNERS') +C +C +C**********************************************************************C +C +C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED AT (N+1) +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + IF(ISWAVE.GE.1)THEN +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TVAR3S(L)=TSY(LNC(L)) + TVAR3W(L)=TSX(L+1) + TVAR3E(L)=TBX(L+1 ) + TVAR3N(L)=TBY(LNC(L)) + ENDDO +C +!$OMP PARALLEL DO PRIVATE(TAUBC2,TAUBC,UTMP,VTMP,CURANG) + DO L=LMPI2,LMPILA +! { GEOSR (IBM request) + IF (ISNAN(TVAR3S(L))) TVAR3S(L)=0. + IF (ISNAN(TVAR3W(L))) TVAR3W(L)=0. + IF (ISNAN(TVAR3E(L))) TVAR3E(L)=0. + IF (ISNAN(TVAR3N(L))) TVAR3N(L)=0. + IF (ISNAN(TSY(L))) TSY(L)=0. + IF (ISNAN(TSX(L))) TSX(L)=0. + IF (ISNAN(TBY(L))) TBY(L)=0. + IF (ISNAN(TBX(L))) TBX(L)=0. +! } GEOSR (IBM request) + TAUBC2 = (RSSBCE(L)*TVAR3E(L)+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TVAR3N(L)+RSSBCS(L)*TBY(L))**2 + TAUBC=0.5*SQRT(TAUBC2) + UTMP=0.5*STCUV(L)*(U(L+1,1)+U(L,1))+1.E-12 + VTMP=0.5*STCUV(L)*(V(LN,1)+V(L,1)) + CURANG=ATAN2(VTMP,UTMP) + TAUB2=TAUBC*TAUBC+0.5*(QQWV1(L)*QQWV1(L)) + & +FOURDPI*TAUBC*QQWV1(L)*COS(CURANG-WACCWE(L)) + TAUB2=MAX(TAUB2,0.) + QQ(L,0 )=CTURB2*SQRT(TAUB2) + QQ(L,KC)=0.5*CTURB2*SQRT((TVAR3W(L)+TSX(L))**2 + & +(TVAR3S(L)+TSY(L))**2) + QQSQR(L,0)=SQRT(QQ(L,0)) ! *** DSLLC + ENDDO +C + ENDIF +C + MPI_WTIMES(26)=MPI_WTIMES(26)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE TURBULENT INTENSITY SQUARED +C + STIME=MPI_TIC() +C + IF(KC.GT.1)THEN + IF(ISQQ.EQ.1)THEN + IF(ISTOPT(0).EQ.0)CALL CALQQ2TOLD_mpi (ISTL) + IF(ISTOPT(0).GE.1)CALL CALQQ2T_mpi (ISTL) + ENDIF + IF(ISQQ.EQ.2) CALL CALQQ2 (ISTL) + ENDIF +C + MPI_WTIMES(27)=MPI_WTIMES(27)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE MEAN MASS TRANSPORT FIELD +C + STIME=MPI_TIC() +C + IF(ISSSMMT.NE.2)THEN + IF(ISICM.GE.1)THEN + NTMP=MOD(N,2) + IF(ISTL.EQ.3.AND.NTMP.EQ.0) CALL CALMMT + ENDIF + ENDIF +C +C IF(ISSSMMT.NE.2) CALL CALMMT +C + MPI_WTIMES(28)=MPI_WTIMES(28)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** HYDRODYNAMIC CALCULATIONS FOR THIS TIME STEP ARE COMPLETED +C +C**********************************************************************C +C +C ** WRITE TO TIME SERIES FILES +C + STIME=MPI_TIC() +C + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*FLOAT(N)+TCON*TBEGIN + CTIM=CTIM/TCON + ELSE + CTIM=TIMESEC/TCON + ENDIF +C +CDYN IF(ISTMSR.GE.1)THEN +CDYN IF(N.GE.NBTMSR.AND.N.LE.NSTMSR)THEN +CDYN IF(NCTMSR.EQ.NWTMSR)THEN +CDYN CALL TMSR +CDYN ICALLTP=1 +CDYN NCTMSR=1 +CDYN ELSE +CDYN NCTMSR=NCTMSR+1 +CDYN ENDIF +CDYN ENDIF +CDYN ENDIF +C +C + IF(ISTMSR.GE.1)THEN +c IF(N.GE.NBTMSR.AND.N.LE.NSTMSR)THEN + IF(NCTMSR.GE.NWTMSR)THEN + CALL TMSR + NDIFF=NWTMSR-NCTMSR + ICALLTP=1 + NCTMSR=NINCRMT+NDIFF + ELSE + NCTMSR=NCTMSR+NINCRMT + ENDIF +c ENDIF + ENDIF +C +C**************************************************** +C ** WRITE TO DUMP FILES ******************C +C +C + IF(ISDUMP.GE.1)THEN + IF(CTIM.GE.TSDUMP.AND.CTIM.LE.TEDUMP)THEN +C IF(NCDUMP.EQ.NSDUMP)THEN + IF(NCDUMP.GE.NSDUMP)THEN + CALL DUMP + NDIFF=NSDUMP-NCDUMP + ICALLTP=1 +C NCDUMP=1 + NCDUMP=NINCRMT+NDIFF + ELSE +C NCDUMP=NCDUMP+1 + NCDUMP=NCDUMP+NINCRMT + ENDIF + ENDIF + ENDIF +C +C**********************************************************************C +C +C ** OUTPUT ZERO DIMENSION VOLUME BALANCE +C +C----------------------------------------------------------------------C +C + IF(ISDRY.GE.1.AND.ISDRY.LT.98)THEN + IF(ICALLTP.EQ.1.AND.DEBUG)THEN + OPEN(1,FILE='ZVOLBAL.OUT',POSITION='APPEND',STATUS='UNKNOWN') + DO LS=1,LORMAX + IF(VOLZERD.GE.VOLSEL(LS).AND.VOLZERD.LT.VOLSEL(LS+1))THEN + WTM=VOLSEL(LS+1)-VOLZERD + WTMP=VOLZERD-VOLSEL(LS) + DELVOL=VOLSEL(LS+1)-VOLSEL(LS) + WTM=WTM/DELVOL + WTMP=WTMP/DELVOL + SELZERD=WTM*BELSURF(LS)+WTMP*BELSURF(LS+1) + ASFZERD=WTM*ASURFEL(LS)+WTMP*ASURFEL(LS+1) + ENDIF + ENDDO + IF(ISDYNSTP.EQ.0)THEN + CTIM=DT*FLOAT(N)+TCON*TBEGIN + CTIM=CTIM/TCTMSR + ELSE + CTIM=TIMESEC/TCTMSR + ENDIF + WRITE(1,5304) CTIM,SELZERD,ASFZERD,VOLZERD,VETZERD + CLOSE(1) + ENDIF + ENDIF + ICALLTP=0 +C + 5304 FORMAT(2X,F10.4,2X,F10.5,3(2X,E12.4)) +C +C**********************************************************************C +C +C ** WRITE VERTICAL SCALAR FIELD PROFILES +C + IF(ISVSFP.EQ.1)THEN + IF(N.GE.NBVSFP.AND.N.LE.NSVSFP)THEN + CALL VSFP + ENDIF + ENDIF +C + MPI_WTIMES(29)=MPI_WTIMES(29)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE MEAN MASS TRANSPORT FIELD +C + STIME=MPI_TIC() +C + IF(ISSSMMT.NE.2)THEN + IF(ISICM.EQ.0) CALL CALMMT + ENDIF +C +C IF(ISSSMMT.NE.2) CALL CALMMT +C + MPI_WTIMES(30)=MPI_WTIMES(30)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** ADVANCE NEUTRALLY BUOYANT PARTICLE DRIFTER TRAJECTORIES +C + !IF(ISPD.EQ.1)THEN + ! IF(N.GE.NPDRT) CALL DRIFTER +C + STIME=MPI_TIC() +C +!{GEOSR, OIL, CWCHO, 101122 + IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN !DHC + IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN + CALL CPU_TIME(T1TMP) + CALL DRIFTERC + CALL CPU_TIME(T2TMP) + TLRPD=TLRPD+T2TMP-T1TMP + ENDIF + ENDIF + + + IF(IDTOX.GE.4440)THEN + IF (TIMEDAY.GE.REAL(NPTXLDS/86400.).AND. + & TIMEDAY.LE.REAL(NPTXLDE/86400.)) THEN + CALL DRIFTERC + ENDIF + ENDIF +!GEOSR} +C + MPI_WTIMES(31)=MPI_WTIMES(31)+MPI_TOC(STIME) +C +! IF(ISLRPD.GE.1)THEN +! CALL CPU_TIME(T1TMP) !DHC:13-04-09 +! IF(ISLRPD.LE.2)THEN +! IF(N.GE.NLRPDRT(1)) CALL LAGRES +! ENDIF +! IF(ISLRPD.GE.3)THEN +! IF(N.GE.NLRPDRT(1)) CALL GLMRES +! ENDIF +! TLRPD=TLRPD+T1TMP-SECOND() +! ENDIF +C +C**********************************************************************C +C +C ** CALCULATE VOLUME MASS, MOMENTUM AND ENERGY BALANCES +C +C IF(ISBAL.GE.1)THEN +C CALL CALBAL5 +C NTMP=MOD(N,2) +C IF(NTMP.EQ.0)THEN +C CALL CBALEV5 +C ELSE +C CALL CBALOD5 +C ENDIF +C ENDIF +C +C SEDIMENT BUDGET CALCULATION (DLK 10/15) +C +C IF(ISSBAL.GE.1)THEN +C CALL BUDGET5 +C ENDIF +C NTMP=MOD(N,2) +C IF(NTMP.EQ.0)THEN +C CALL BUDGEV5 +C ELSE +C CALL BUDGOD5 +C ENDIF +C +C ** CALL TWO-TIME LEVEL BALANCES +C + STIME=MPI_TIC() +C + IF(ISBAL.GE.1)THEN + CALL BAL2T5 + ENDIF +C + MPI_WTIMES(32)=MPI_WTIMES(32)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** PERFORM AN M2 TIDE HARMONIC ANALYSIS EVERY 2 M2 PERIODS +C + STIME=MPI_TIC() +C + IF(ISHTA.EQ.1) CALL CALHTA +C + MPI_WTIMES(33)=MPI_WTIMES(33)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** CALCULATE DISPERSION COEFFICIENTS +C +C IF(N.GE.NDISP)THEN + STIME=MPI_TIC() +C + IF(N.GE.NDISP.AND.NCTBC.EQ.1)THEN + IF(ISDISP.EQ.2) CALL CALDISP2 + IF(ISDISP.EQ.3) CALL CALDISP3 + ENDIF +C + MPI_WTIMES(34)=MPI_WTIMES(34)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** PERFORM LEAST SQUARES HARMONIC ANALYSIS AT SELECTED LOCATIONS +C + STIME=MPI_TIC() +C + IF(ISLSHA.EQ.1.AND.N.EQ.NCLSHA)THEN + CALL LSQHARM + NCLSHA=NCLSHA+(NTSPTC/24) + ENDIF +C + MPI_WTIMES(35)=MPI_WTIMES(35)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** PRINT INTERMEDIATE RESULTS +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + IF(NPRINT .EQ. NTSPP)THEN + NPRINT=1 + CALL OUTPUT1 + ELSE + NPRINT=NPRINT+1 + ENDIF +C + MPI_WTIMES(36)=MPI_WTIMES(36)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** WRITE TO TIME VARYING GRAPHICS FILES +C +C----------------------------------------------------------------------C +C +CDYN IF(N.EQ.NCPPH.AND.ISPPH.EQ.1)THEN +Cpmc IF(N.GE.NCPPH.AND.ISPPH.GE.1)THEN +C + STIME=MPI_TIC() +C + IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN + CALL SURFPLT + ENDIF +C + MPI_WTIMES(37)=MPI_WTIMES(37)+MPI_TOC(STIME) +C +C +C----------------------------------------------------------------------C +C +CDYN IF(N.EQ.NCBPH.AND.ISBPH.EQ.1)THEN +C + STIME=MPI_TIC() +C + IF(N.GE.NCBPH.AND.ISBPH.GE.1)THEN + IF(ISBEXP.EQ.0)THEN + CALL BEDPLTH + NCBPH=NCBPH+(NTSPTC/NPBPH) + ENDIF + ENDIF +C + MPI_WTIMES(38)=MPI_WTIMES(38)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +CDYN IF(N.EQ.NCVPH.AND.ISVPH.GE.1)THEN +C + STIME=MPI_TIC() +C + IPLTTMP=0 + IF(ISVPH.EQ.1.OR.ISVPH.EQ.2)IPLTTMP=1 + IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS).AND.IPLTTMP.EQ.1)THEN + CALL VELPLTH_mpi + ENDIF +C + MPI_WTIMES(39)=MPI_WTIMES(39)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +CDYN IF(N.EQ.NCVPV.AND.ISVPV.GE.1)THEN +C + STIME=MPI_TIC() +C + IF(N.GE.NCVPV.AND.ISVPV.GE.1)THEN + CALL VELPLTV + NCVPV=NCVPV+(NTSPTC/NPVPV) + ENDIF +C + MPI_WTIMES(40)=MPI_WTIMES(40)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + DO K=1,KC +!$OMP PARALLEL DO + DO L=LMPI1,LMPILC + TVAR1S(L,K)=TOX(L,K,1) + ENDDO + ENDDO +C + IPLTTMP=0 + IF(ISSPH(1).EQ.1.OR.ISSPH(1).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(1).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(1).GE.1) CALL SALPLTH (1,SAL) + NCSPH(1)=NCSPH(1)+(NTSPTC/NPSPH(1)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(2).EQ.1.OR.ISSPH(2).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(2).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(2).GE.1) CALL SALPLTH (2,TEM) + NCSPH(2)=NCSPH(2)+(NTSPTC/NPSPH(2)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(3).EQ.1.OR.ISSPH(3).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(3).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(3).GE.1) CALL SALPLTH (3,DYE) + NCSPH(3)=NCSPH(3)+(NTSPTC/NPSPH(3)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(4).EQ.1.OR.ISSPH(4).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(4).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(4).GE.1) CALL SALPLTH (4,SFL) + NCSPH(4)=NCSPH(4)+(NTSPTC/NPSPH(4)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(5).EQ.1.OR.ISSPH(5).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(5).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(5).GE.1) CALL SALPLTH (5,TVAR1S) + NCSPH(5)=NCSPH(5)+(NTSPTC/NPSPH(5)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(6).EQ.1.OR.ISSPH(6).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(6).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(6).GE.1) CALL SALPLTH (6,SEDT) + NCSPH(6)=NCSPH(6)+(NTSPTC/NPSPH(6)) + ENDIF +C + IPLTTMP=0 + IF(ISSPH(7).EQ.1.OR.ISSPH(7).EQ.2)IPLTTMP=1 + IF(N.GE.NCSPH(7).AND.IPLTTMP.EQ.1)THEN + IF(ISTRAN(7).GE.1) CALL SALPLTH (7,SNDT) + NCSPH(7)=NCSPH(7)+(NTSPTC/NPSPH(7)) + ENDIF +C + MPI_WTIMES(41)=MPI_WTIMES(41)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + DO ITMP=1,7 + IF(N.GE.NCSPV(ITMP).AND.ISSPV(ITMP).GE.1)THEN + CALL SALPLTV(ITMP) + NCSPV(ITMP)=NCSPV(ITMP)+(NTSPTC/NPSPV(ITMP)) + ENDIF + ENDDO +C + MPI_WTIMES(42)=MPI_WTIMES(42)+MPI_TOC(STIME) +C +C----------------------------------------------------------------------C +C +C ** WRITE EFDC EXPLORER FORMAT OUTPUT +C + STIME=MPI_TIC() +C + IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1)THEN + IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN + IF(IBIN_TYPE.EQ.1)THEN + IF(MYRANK.EQ.0) WRITE(88,*) 'EEXPOUT_mpi' + CALL EEXPOUT_mpi(0) + ELSEIF(IBIN_TYPE.EQ.0)THEN + IF(MYRANK.EQ.0) WRITE(88,*) 'EEXPOUT_opt_mpi' + CALL EEXPOUT_opt_mpi(0) + ENDIF + ENDIF + ENDIF + IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN + NSNAPSHOTS=NSNAPSHOTS+1 + ENDIF +C + MPI_WTIMES(43)=MPI_WTIMES(43)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** WRITE TO TIME VARYING 3D HDF GRAPHICS FILES +C +C----------------------------------------------------------------------C +C + STIME=MPI_TIC() +C + IF(N.EQ.NC3DO.AND.IS3DO.EQ.1)THEN + CALL OUT3D + NC3DO=NC3DO+(NTSPTC/NP3DO) + ENDIF +C + MPI_WTIMES(44)=MPI_WTIMES(44)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** WRITE RESTART FILE EVERY ISRESTO M2 TIDAL CYCLES +C + STIME=MPI_TIC() +C + IF(ISRESTO.GE.1)THEN + IF((N-ISSREST).GT.NRESTO)THEN + if(myrank.eq.0) print*,'R1ESTOUT(0)' + CALL RESTOUT(0) + IF(ISTRAN(8).GE.1)THEN + IF(IWQRST.EQ.1) CALL WWQRST(0) + IF(IWQBEN.EQ.1 .AND. ISMRST.EQ.1) CALL WSMRST(0) + ENDIF + ISSREST=N + ENDIF + ENDIF +! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 + IF(ISRESTO.LT.-20)THEN + IF((N-ISSREST).GT.NTSPTC)THEN + if(myrank.eq.0) print*,'R1ESTOUT(-19)' + CALL RESTOUT(-19) + IF(ISTRAN(8).GE.1)THEN + IF(IWQRST.EQ.1) CALL WWQRST(1) + IF(IWQBEN.EQ.1 .AND. ISMRST.EQ.1) CALL WSMRST(1) + ENDIF + ISSREST=N + ENDIF + ENDIF +! } GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 + +! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 + IF(ISRESTO.LT.-20)THEN + ISHYD=-1*ISRESTO-20 + IF (N.EQ.1) THEN + IHYDCNT=1 + SNAPSHOTHYD=FLOAT(ISHYD*IHYDCNT)*60./86400.+TBEGIN + ENDIF + IF(TIMEDAY.GE.SNAPSHOTHYD) THEN +! WRITE(*,*)'WRITE================',N,TIMEDAY,TIMEDAY*1440. +! CALL RESTOUT(-21) + IHYDCNT=IHYDCNT+1 + SNAPSHOTHYD=FLOAT(ISHYD*IHYDCNT)*60./86400.+TBEGIN + ENDIF + ENDIF +! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 +C + MPI_WTIMES(45)=MPI_WTIMES(45)+MPI_TOC(STIME) +C +C**********************************************************************C +C +C ** RECORD TIME +C +C ** DTIME AND FLUSH ARE SUPPORTED ON SUN SYSTEMS, BUT MAY NOT BE +C ** SUPPORTED ON OTHER SYSTEMS. +C + STIME=MPI_TIC() + + IF(NTIMER.EQ.NTSPTC)THEN +C *** EE BEGIN BLOCK + IF(MYRANK.EQ.0) CALL TIMELOG(N,TIMEDAY) +C *** EE END BLOCK + NTIMER=1 + ELSE + NTIMER=NTIMER+1 + ENDIF +C +C**********************************************************************C +C + IF(N.EQ.1)THEN + OPEN(1,FILE='SHOW.INP',STATUS='OLD') + DO NSKIP=1,6; READ(1,*); ENDDO + READ(1,*)NSHTYPE,NSHOWR,ICSHOW,JCSHOW,ISHPRT + CLOSE(1) + ENDIF +C + L=LIJ(ICSHOW,JCSHOW) + IF(ISHOW.GT.0.AND.L.GE.LMPI2.AND.L.LE.LMPILA) CALL SHOWVAL +C + MPI_WTIMES(46)=MPI_WTIMES(46)+MPI_TOC(STIME) +C**********************************************************************C +C +C *** DJB +![ykchoi 10.04.26 for linux version + MPI_WTIMES(1)=MPI_WTIMES(1)+MPI_TOC(TTIME) + WT_RATIO=1 + IF(PRINT_SUM)THEN + IF(MOD(N,100).EQ.0)THEN + call collect_in_zero(TSX) + call collect_in_zero(TSY) + call collect_in_zero(TBX) + call collect_in_zero(TBY) + call collect_in_zero_array(AV) + call collect_in_zero_array(AB) + call collect_in_zero_array(AQ) + call collect_in_zero(HP) + call collect_in_zero(HU) + call collect_in_zero(HV) + call collect_in_zero(P) + call collect_in_zero(TEMB) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + call collect_in_zero_array(W) + call collect_in_zero_array(TEM) + call collect_in_zero_array(SAL) + call collect_in_zero_array(SEDT) + do k=0,kcm + call collect_in_zero(QQ(:,k)) + call collect_in_zero(QQL(:,k)) + enddo + DO NW=1,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + call collect_in_zero_array(QSUM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'TSX = ', sum(abs(dble(TSX))) + PRINT*, n,'TSY = ', sum(abs(dble(TSY))) + PRINT*, n,'TBX = ', sum(abs(dble(TBX))) + PRINT*, n,'TBY = ', sum(abs(dble(TBY))) + PRINT*, n,'AV = ', sum(abs(dble(AV))) + PRINT*, n,'AB = ', sum(abs(dble(AB))) + PRINT*, n,'AQ = ', sum(abs(dble(AQ))) + PRINT*, n,'HP = ', sum(abs(dble(HP))) + PRINT*, n,'HU = ', sum(abs(dble(HU))) + PRINT*, n,'HV = ', sum(abs(dble(HV))) + PRINT*, n,'P = ', sum(abs(dble(P))) + PRINT*, n,'U = ', sum(abs(dble(U))) + PRINT*, n,'V = ', sum(abs(dble(V))) + PRINT*, n,'W = ', sum(abs(dble(W))) + PRINT*, n,'TEM = ', sum(abs(dble(TEM))) + PRINT*, n,'SAL = ', sum(abs(dble(SAL))) + PRINT*, n,'TEMB = ', sum(abs(dble(TEMB))) + PRINT*, n,'SEDT = ', sum(abs(dble(SEDT))) + PRINT*, n,'QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'QQL = ', sum(abs(dble(QQL))) + PRINT*, n,'WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'WQVX = ', sum(abs(dble(WQVX))) + PRINT*, n,'QSUM = ', sum(abs(dble(QSUM))) + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + ENDIF + ENDIF + + IF(PRINT_SUM)THEN + IF(MOD(N,NTSPTC/WT_RATIO/24).EQ.0)THEN + call collect_in_zero(TSX) + call collect_in_zero(TSY) + call collect_in_zero(TBX) + call collect_in_zero(TBY) + call collect_in_zero_array(AV) + call collect_in_zero_array(AB) + call collect_in_zero_array(AQ) + call collect_in_zero(HP) + call collect_in_zero(HU) + call collect_in_zero(HV) + call collect_in_zero(P) + call collect_in_zero(TEMB) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + call collect_in_zero_array(W) + call collect_in_zero_array(TEM) + call collect_in_zero_array(SAL) + call collect_in_zero_array(SEDT) + do k=0,kcm + call collect_in_zero(QQ(:,k)) + call collect_in_zero(QQL(:,k)) + enddo + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + call collect_in_zero_array(QSUM) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'TSX = ', sum(abs(dble(TSX))) + PRINT*, n,'TSY = ', sum(abs(dble(TSY))) + PRINT*, n,'TBX = ', sum(abs(dble(TBX))) + PRINT*, n,'TBY = ', sum(abs(dble(TBY))) + PRINT*, n,'AV = ', sum(abs(dble(AV))) + PRINT*, n,'AB = ', sum(abs(dble(AB))) + PRINT*, n,'AQ = ', sum(abs(dble(AQ))) + PRINT*, n,'HP = ', sum(abs(dble(HP))) + PRINT*, n,'HU = ', sum(abs(dble(HU))) + PRINT*, n,'HV = ', sum(abs(dble(HV))) + PRINT*, n,'P = ', sum(abs(dble(P))) + PRINT*, n,'U = ', sum(abs(dble(U))) + PRINT*, n,'V = ', sum(abs(dble(V))) + PRINT*, n,'W = ', sum(abs(dble(W))) + PRINT*, n,'TEM = ', sum(abs(dble(TEM))) + PRINT*, n,'SAL = ', sum(abs(dble(SAL))) + PRINT*, n,'TEMB = ', sum(abs(dble(TEMB))) + PRINT*, n,'SEDT = ', sum(abs(dble(SEDT))) + PRINT*, n,'QQ = ', sum(abs(dble(QQ))) + PRINT*, n,'QQL = ', sum(abs(dble(QQL))) + PRINT*, n,'WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'WQVX = ', sum(abs(dble(WQVX))) + PRINT*, n,'QSUM = ', sum(abs(dble(QSUM))) + ENDIF + ENDIF + ENDIF + + IF(MOD(N,NTSPTC/WT_RATIO).EQ.0)THEN + MPI_HOSTSPOTS ='NULL' + MPI_HOSTSPOTS( 1)='HDMT2T_TOTAL' + MPI_HOSTSPOTS( 4)='CALAVB' + MPI_HOSTSPOTS( 6)='CALTSXY' + MPI_HOSTSPOTS( 7)='CALEXP2T' + MPI_HOSTSPOTS( 8)='CALCSER' + MPI_HOSTSPOTS( 9)='CALPUV2C' + MPI_HOSTSPOTS(10)='ADVANCE' + MPI_HOSTSPOTS(11)='CALUVW' + MPI_HOSTSPOTS(12)='CALCONC' + MPI_HOSTSPOTS(13)='SEDIMENT' + MPI_HOSTSPOTS(15)='DSLLC_WRITE' + MPI_HOSTSPOTS(16)='WQ3D' + MPI_HOSTSPOTS(17)='CALBUOY' + MPI_HOSTSPOTS(19)='NLEVEL' + MPI_HOSTSPOTS(20)='CALHDMF' + MPI_HOSTSPOTS(21)='CALTBXY' + MPI_HOSTSPOTS(23)='QQSQR' + MPI_HOSTSPOTS(27)='CALQQ2T' + MPI_HOSTSPOTS(35)='LSQHARM' + MPI_HOSTSPOTS(37)='SURFPLT' + MPI_HOSTSPOTS(39)='VELPLTH' + MPI_HOSTSPOTS(41)='SALPTH' + MPI_HOSTSPOTS(43)='EEXPOUT' + IF(NPROCS.GE.2)THEN + MPI_HOSTSPOTS(51)='BCAST1' + MPI_HOSTSPOTS(52)='BCAST2' + MPI_HOSTSPOTS(53)='BCAST3' + MPI_HOSTSPOTS(54)='BCAST4' + MPI_HOSTSPOTS(55)='BCAST5' + MPI_HOSTSPOTS(56)='BCAST6' + MPI_HOSTSPOTS(61)='BARRIER1' + MPI_HOSTSPOTS(62)='BARRIER2' + MPI_HOSTSPOTS(63)='BARRIER3' + MPI_HOSTSPOTS(64)='BARRIER4' + MPI_HOSTSPOTS(65)='BARRIER5' + ENDIF + + IF(MYRANK.EQ.0)THEN + PRINT*,'HDMT2T' + DO II=1,65 + IF(TRIM(MPI_HOSTSPOTS(000+II)).NE.'NULL') + & WRITE(*,'(I5,2X,A20,F10.3)') II,MPI_HOSTSPOTS(000+II), + & (WT_RATIO*REAL(MPI_WTIMES(000+II))) + ENDDO + ENDIF + ENDIF + + GOTO 1001 +! IF(.NOT.KBHIT())GOTO 1001 +! I1=GETCH() +! WRITE(*,'(A)')'PROGRAM PAUSED BY USER' +! WRITE(*,'(A)')' EFDC_DS: TO EXIT PRESS THE SAME KEY' +! WRITE(*,'(A)')' EFDC_DS: TO CONTINUE RUN PRESS ANY OTHER KEY' +! I2=GETCH() +! IF(I1.NE.I2)GOTO 1001 +!ykchoi] +C + 1000 CONTINUE +C +C**********************************************************************C +C +C ** TIME LOOP COMPLETED +C + CALL CPU_TIME(T1TMP) + THDMT=THDMT+T1TMP-TTMP +C +C**********************************************************************C +C *** EE BEGIN BLOCK +C MOVED THE TIMING OUTPUT BLOCK TO THE MAIN AAEFDC TO ELIMINATE +C UNNECESSARY DUPLICATION +C *** EE END BLOCK +C**********************************************************************C +C +C2000 CONTINUE +C +C**********************************************************************C +C +C ** PRINT FINAL RESULTS +C + IF(MYRANK.EQ.0) CALL OUTPUT2 +C +C**********************************************************************C +C +C ** WRITE RESTART FILE +C +C IF(ISRESTO.EQ.-1.OR.ISRESTO.EQ.-11)THEN ! GEOSR : JGCHO 2011.6.15 + IF(ISRESTO.EQ.-1.OR.ISRESTO.EQ.-11.OR.ISRESTO.LT.-20)THEN ! GEOSR : JGCHO 2011.6.15 + if(myrank.eq.0) print*,'R2ESTOUT(0)' + CALL RESTOUT(0) + IF(ISTRAN(8).GE.1)THEN + IF(IWQRST.EQ.1) CALL WWQRST(0) + IF(IWQBEN.EQ.1 .AND. ISMRST.EQ.1) CALL WSMRST(0) + ENDIF + ENDIF + IF(ISRESTO.EQ.-2)THEN + CALL RESTMOD + ENDIF +! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.6.3 + IF(ISRESTO.LT.-20)THEN + if(myrank.eq.0) print*,'R2ESTOUT(-19)' + CALL RESTOUT(-19) + IF(ISTRAN(8).GE.1)THEN + IF(IWQRST.EQ.1) CALL WWQRST(1) + IF(IWQBEN.EQ.1 .AND. ISMRST.EQ.1) CALL WSMRST(1) + ENDIF + ENDIF +! } GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.6.3 +C +C**********************************************************************C +C +C ** COMPLETE LEAST SQUARES HARMONIC ANALYSIS +C + LSLSHA=1 + IF(ISLSHA.EQ.1) CALL LSQHARM +C +C**********************************************************************C +C +C ** OUTPUT COURANT NUMBER DIAGNOSTICS +C +C *** DSLLC BEGIN BLOCK + IF(MYRANK.EQ.0)THEN + IF(ISINWV.GT.0.AND.DEBUG)THEN + OPEN(1,FILE='CFLMAX.OUT') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='CFLMAX.OUT') +C + DO L=2,LA + WRITE(1,1991)IL(L),JL(L),(CFLUUU(L,K),K=1,KC) + WRITE(1,1992)(CFLVVV(L,K),K=1,KC) + WRITE(1,1992)(CFLWWW(L,K),K=1,KC) + WRITE(1,1992)(CFLCAC(L,K),K=1,KC) + ENDDO +C + CLOSE(1) + ENDIF + ENDIF +C *** DSLLC END BLOCK +C + 1991 FORMAT(2I5,12F8.3) + 1992 FORMAT(10X,12F8.3) + 1993 FORMAT(2I5,E13.5) +C +C**********************************************************************C +C +C ** OUTPUT COSMETIC VOLUME LOSSES FORM DRY CELLS +C + IF(MYRANK.EQ.0)THEN + IF(NDRYSTP.LT.0.AND.DEBUG) THEN +C + OPEN(1,FILE='DRYLOSS.OUT') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='DRYLOSS.OUT') +C + DO L=2,LA + WRITE(1,1993)IL(L),JL(L),VDWASTE(L) + ENDDO +C + CLOSE(1) +C + ENDIF + ENDIF +C +C**********************************************************************C +C +C ** OUTPUT FINAL FOOD CHAIN AVERAGING PERIOD +C + IF(ISTRAN(5).GE.1.AND.ISFDCH.GE.1)CALL FOODCHAIN(1) +C +C**********************************************************************C +C +C ** OUTPUT FINAL MASS AND VOLUME BALANCES +C + IF(IS2TIM.GE.1) THEN + IF(ISBAL.GE.1)THEN + CALL BAL2T5 + ENDIF + ENDIF +C +C**********************************************************************C +C + CLOSE(90) + CLOSE(98) + + RETURN + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM_mpi.for new file mode 100644 index 000000000..bf1669b8e --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM_mpi.for @@ -0,0 +1,47 @@ + SUBROUTINE RWQATM_mpi +C +C CHANGE RECORD +C ** COMPUTES WET ATMOSPHERIC DEPOSITION USING CONSTANT CONCENTRATIONS +C ** FOR THE 22 STATE VARIABLES MULTIPLIED BY THE RAINFALL FLOW RATE !VB CHANGED 21 TO 22 +C ** ENTERING EACH GRID CELL. COMPUTED LOADS ARE IN G/DAY. +C + USE GLOBAL + USE MPI +C +C CV2 = CONVERSION TO GET UNITS OF G/DAY +C WQATM(NW) HAS UNITS OF MG/L +C RAINT(L) HAS UNITS OF M/SEC +C DXYP(L) HAS UNITS OF M2 +C WQATML(L,KC,NW) HAS UNITS OF G/DAY +C + + CV2=86400.0 + DO NW=1,NWQV +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQATML(L,KC,NW)=WQATM(NW)*RAINT(L)*DXYP(L)*CV2 + ENDDO + ENDDO + IF(MYRANK.EQ.0)THEN + IF(ITNWQ.EQ.0.AND.DEBUG)THEN + OPEN(1,FILE='WQATM.DIA',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='WQATM.DIA',STATUS='UNKNOWN') + IF(ISDYNSTP.EQ.0)THEN + TIME=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ELSE + TIME=TIMESEC/86400. + ENDIF + WRITE(1,112) N,TIME + DO L=2,LA + WRITE(1,110) IL(L),JL(L),(WQATML(L,KC,NW),NW=1,NWQV) + ENDDO + CLOSE(1) + ENDIF + ENDIF + 110 FORMAT(1X,2I4,2X,1P,7E11.3,/,15X,7E11.3,/,15X,7E11.3) + 112 FORMAT('# WET ATMOSPHERIC DEPOSITION DIAGNOSTIC FILE',/, + & ' N, TIME = ', I10, F12.5/) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH_mpi.for new file mode 100644 index 000000000..34effde9c --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALPLTH_mpi.for @@ -0,0 +1,589 @@ + SUBROUTINE SALPLTH_mpi (ICON,CONC) +C +C CHANGE RECORD +C ** SUBROUTINE SALPLTH WRITES FILES FOR INSTANTANEOUS SCALAR FIELD +C ** CONTOURING IN HORIZONTAL PLANES +C + USE GLOBAL + USE MPI + + DIMENSION DBS(10) + CHARACTER*80 TITLE + DIMENSION CONC(LCM,KCM) + REAL,ALLOCATABLE,DIMENSION(:)::DBSB + INTEGER LUN + LUN=0 + + S1TIME=MPI_TIC() + ALLOCATE(DBSB(0:NSTM)) + DBSB=0. + MPI_WTIMES(881)=MPI_WTIMES(881)+MPI_TOC(S1TIME) +C + IF(JSSPH(ICON).NE.1) GOTO 300 + S1TIME=MPI_TIC() + LINES=LA-1 + LEVELS=2 + LEVELSS=3 + DBS(1)=0. + DBS(2)=99. + DBS(3)=-99. + LSEDCL=NSED+NSND + DO L=0,LSEDCL + DBSB(L)=FLOAT(L) + ENDDO + IF(ICON.EQ.1.AND.ISPHXY(1).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZONTAL SALINITY CONTOURS' + LUN=11 + OPEN(LUN,FILE='SALCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SALCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELS + WRITE (LUN,250)(DBS(L),L=1,LEVELS) + CLOSE(LUN) + ENDIF + IF(ICON.EQ.2.AND.ISPHXY(2).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZONTAL TEMPERATURE CONTOURS' + LUN=12 + OPEN(LUN,FILE='TEMCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='TEMCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELS + WRITE (LUN,250)(DBS(L),L=1,LEVELS) + CLOSE(LUN) + ENDIF + IF(ICON.EQ.3.AND.ISPHXY(3).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZONTAL DYE CONC CONTOURS' + LUN=13 + OPEN(LUN,FILE='DYECONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='DYECONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELS + WRITE (LUN,250)(DBS(L),L=1,LEVELS) + CLOSE(LUN) + ENDIF + IF(ICON.EQ.6.AND.ISPHXY(6).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZ COHESIVE SEDIMENT CONC CONTOURS' + LUN=14 + OPEN(LUN,FILE='SEDCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SEDCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + ENDIF +C +C TITLE='INSTANTANEOUS BED SED DEPOSITED CONTOURS GM/M**2' +C LUN=15 +C + IF(ICON.EQ.7.AND.ISPHXY(7).LE.2.AND.MYRANK.EQ.0)THEN + IF(NSND.GE.1)THEN + TITLE='INSTANTANEOUS HORIZ NONCOH SEDIMENT CONC CONTOURS' + LUN=15 + OPEN(LUN,FILE='SNDCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SNDCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + ENDIF + IF(NSND.GE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZ NONCOH SEDIMENT CONC CONTOURS' + LUN=15 + OPEN(LUN,FILE='SNDCONH01.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SNDCONH01.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + OPEN(LUN,FILE='SNDCONH02.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SNDCONH02.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + ENDIF + IF(NSND.GE.3.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZ NONCOH SEDIMENT CONC CONTOURS' + LUN=15 + OPEN(LUN,FILE='SNDCONH03.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SNDCONH03.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + ENDIF + ENDIF +C +C TITLE='INSTANTANEOUS BED SED DEPOSITED CONTOURS GM/M**2' +C LUN=15 +C + IF(ICON.EQ.5.AND.ISPHXY(5).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZ TOXIC CONTAM. CONC CONTOURS' + LUN=16 + OPEN(LUN,FILE='TOXCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='TOXCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + TITLE='INSTANTANEOUS HORIZ TOXIC PART FRAC CONTOURS' + LUNF=26 + OPEN(LUNF,FILE='TXPCONH.OUT') + CLOSE(LUNF,STATUS='DELETE') + OPEN(LUNF,FILE='TXPCONH.OUT') + WRITE (LUNF,99) TITLE + WRITE (LUNF,101)LINES,LEVELSS + WRITE (LUNF,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUNF) + ENDIF + IF(ICON.EQ.4.AND.ISPHXY(4).LE.2.AND.MYRANK.EQ.0)THEN + TITLE='INSTANTANEOUS HORIZONTAL SFL CONC CONTOURS' + LUN=17 + OPEN(LUN,FILE='SFLCONH.OUT') + CLOSE(LUN,STATUS='DELETE') + OPEN(LUN,FILE='SFLCONH.OUT') + WRITE (LUN,99) TITLE + WRITE (LUN,101)LINES,LEVELSS + WRITE (LUN,250)(DBS(L),L=1,LEVELSS) + CLOSE(LUN) + ENDIF + JSSPH(ICON)=0 + MPI_WTIMES(882)=MPI_WTIMES(882)+MPI_TOC(S1TIME) + 300 CONTINUE + S1TIME=MPI_TIC() + IF(ICON.EQ.1.AND.ISPHXY(1).LE.2.AND.MYRANK.EQ.0)THEN + LUN=11 + OPEN(LUN,FILE='SALCONH.OUT',POSITION='APPEND') + ENDIF + IF(ICON.EQ.2.AND.ISPHXY(2).LE.2.AND.MYRANK.EQ.0)THEN + LUN=12 + OPEN(LUN,FILE='TEMCONH.OUT',POSITION='APPEND') + ENDIF + IF(ICON.EQ.3.AND.ISPHXY(3).LE.2.AND.MYRANK.EQ.0)THEN + LUN=13 + OPEN(LUN,FILE='DYECONH.OUT',POSITION='APPEND') + ENDIF + IF(ICON.EQ.6.AND.ISPHXY(6).LE.2.AND.MYRANK.EQ.0)THEN + LUN=14 + OPEN(LUN,FILE='SEDCONH.OUT',POSITION='APPEND') + ENDIF + IF(ICON.EQ.7.AND.ISPHXY(7).LE.2.AND.MYRANK.EQ.0)THEN + LUN=15 + OPEN(LUN,FILE='SNDCONH.OUT',POSITION='APPEND') + IF(NSND.GE.2)THEN + LUN1=25 + OPEN(LUN1,FILE='SNDCONH01.OUT',POSITION='APPEND') + LUN2=35 + OPEN(LUN2,FILE='SNDCONH02.OUT',POSITION='APPEND') + ENDIF + IF(NSND.GE.3)THEN + LUN3=45 + OPEN(LUN3,FILE='SNDCONH03.OUT',POSITION='APPEND') + ENDIF + ENDIF + IF(ICON.EQ.5.AND.ISPHXY(5).LE.2.AND.MYRANK.EQ.0)THEN + LUN=16 + OPEN(LUN,FILE='TOXCONH.OUT',POSITION='APPEND') + LUNF=26 + OPEN(LUNF,FILE='TXPCONH.OUT',POSITION='APPEND') + ENDIF + IF(ICON.EQ.4.AND.ISPHXY(4).LE.2.AND.MYRANK.EQ.0)THEN + LUN=17 + OPEN(LUN,FILE='SFLCONH.OUT',POSITION='APPEND') + ENDIF + MPI_WTIMES(883)=MPI_WTIMES(883)+MPI_TOC(S1TIME) +C +C LUB=18 +C LUB=18 +C + S1TIME=MPI_TIC() + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + TIME=TIME/TCON + ELSE + TIME=TIMESEC/TCON + ENDIF + IF(ISPHXY(ICON).LE.2.AND.MYRANK.EQ.0)THEN + WRITE (LUN,100)N,TIME + IF(ICON.EQ.5)THEN + WRITE (LUNF,100)N,TIME + ENDIF + IF(ICON.EQ.7)THEN + IF(NSND.GE.2)THEN + WRITE (LUN1,100)N,TIME + WRITE (LUN2,100)N,TIME + ENDIF + IF(NSND.GE.3)THEN + WRITE (LUN3,100)N,TIME + ENDIF + ENDIF + ENDIF + IF(ISPHXY(ICON).EQ.0.AND.MYRANK.EQ.0)THEN + IF(ICON.LE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,400)CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,400)CONC(L,KC),CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.GE.8)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,400)CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,400)CONC(L,KC),CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.6)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,400)CONC(L,1),SEDBT(L,KBT(L)),SEDF(L,0,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,400)CONC(L,KC),CONC(L,1),SEDBT(L,KBT(L)), + & SEDF(L,0,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.7)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,400)CONC(L,1),SNDBT(L,KBT(L)) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,400)CONC(L,KC),CONC(L,1),SNDBT(L,KBT(L)) + ENDDO + ENDIF + IF(NSND.GE.2)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN1,400)SND(L,1,1),SNDB(L,KBT(L),1), + & SNDF(L,0,1),SNDFBL(L,1),CQBEDLOADX(L,1) + WRITE(LUN2,400)SND(L,1,2),SNDB(L,KBT(L),2), + & SNDF(L,0,2),SNDFBL(L,2),CQBEDLOADX(L,2) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN1,400)SND(L,KC,1),SND(L,1,1),SNDB(L,KBT(L),1), + & SNDF(L,0,1),SNDFBL(L,1),CQBEDLOADX(L,1) + WRITE(LUN2,400)SND(L,KC,2),SND(L,1,2),SNDB(L,KBT(L),2), + & SNDF(L,0,2),SNDFBL(L,2),CQBEDLOADX(L,2) + ENDDO + ENDIF + ENDIF + IF(NSND.GE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN3,400)SND(L,1,NSND),SNDB(L,KBT(L),NSND), + & SNDF(L,0,NSND),SNDFBL(L,NSND),CQBEDLOADX(L,NSND) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN3,400)SND(L,KC,NSND),SND(L,1,NSND), + & SNDB(L,KBT(L),NSND),SNDF(L,0,NSND),SNDFBL(L,NSND), + & CQBEDLOADX(L,NSND) + ENDDO + ENDIF + ENDIF + ENDIF + IF(ICON.EQ.5)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,400)TOX(L,1,1),TOXB(L,KBT(L),1), + & TOXF(L,0,1),TOXFB(L,KBT(L),1) + WRITE(LUNF,400)TOXPFTW(L,1,1),TOXPFTB(L,KBT(L),1) + ENDDO + ENDIF + IF(KC.GT.1)THEN + DO L=2,LA + WRITE(LUN,400)TOX(L,KC,1),TOX(L,1,1),TOXB(L,KBT(L),1), + & TOXB(L,1,1) + WRITE(LUNF,400)TOXPFTW(L,KC,1),TOXPFTW(L,1,1), + & TOXPFTB(L,KBT(L),1),TOXPFTB(L,1,1) + ENDDO + ENDIF + CLOSE(LUNF) + ENDIF + IF(ICON.EQ.4)THEN + DO L=2,LA + WRITE(LUN,400)CONC(L,KC),CONC(L,1), + & SFLSBOT(L) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(884)=MPI_WTIMES(884)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISPHXY(ICON).EQ.1.AND.MYRANK.EQ.0)THEN + IF(ICON.LE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,KC),CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.GE.8)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,KC),CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.6)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,1),SEDBT(L,KBT(L)), + & SEDF(L,0,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,KC),CONC(L,1), + & SEDBT(L,KBT(L)),SEDF(L,0,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.7)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,1),SNDBT(L,KBT(L)) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,KC),CONC(L,1), + & SNDBT(L,KBT(L)) + ENDDO + ENDIF + IF(NSND.GE.2)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN1,200)IL(L),JL(L),SND(L,1,1),SNDB(L,KBT(L),1), + & SNDF(L,0,1),SNDFBL(L,1),CQBEDLOADX(L,1) + WRITE(LUN2,200)IL(L),JL(L),SND(L,1,2),SNDB(L,KBT(L),2), + & SNDF(L,0,2),SNDFBL(L,2),CQBEDLOADX(L,2) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN1,200)IL(L),JL(L),SND(L,KC,1),SND(L,1,1), + & SNDB(L,KBT(L),1),SNDF(L,0,1),SNDFBL(L,1) + & ,CQBEDLOADX(L,1) + WRITE(LUN2,200)IL(L),JL(L),SND(L,KC,2),SND(L,1,2), + & SNDB(L,KBT(L),2),SNDF(L,0,2),SNDFBL(L,2) + & ,CQBEDLOADX(L,2) + ENDDO + ENDIF + ENDIF + IF(NSND.GE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN3,200)IL(L),JL(L),SND(L,1,NSND),SNDB(L,KBT(L) + & ,NSND),SNDF(L,0,NSND),SNDFBL(L,NSND) + & ,CQBEDLOADX(L,NSND) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN3,200)IL(L),JL(L),SND(L,KC,NSND),SND(L,1,NSND), + & SNDB(L,KBT(L),NSND),SNDF(L,0,NSND),SNDFBL(L,NSND), + & CQBEDLOADX(L,NSND) + ENDDO + ENDIF + ENDIF + ENDIF + IF(ICON.EQ.5)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),TOX(L,1,1),TOXB(L,KBT(L),1), + & TOXF(L,0,1),TOXFB(L,KBT(L),1) + WRITE(LUNF,200)IL(L),JL(L),TOXPFTW(L,1,1),TOXPFTB(L, + & KBT(L),1) + ENDDO + ENDIF + IF(KC.GT.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),TOX(L,KC,1),TOX(L,1,1), + & TOXB(L,KBT(L),1),TOXB(L,1,1) + WRITE(LUNF,200)IL(L),JL(L),TOXPFTW(L,KC,1),TOXPFTW(L,1,1), + & TOXPFTB(L,KBT(L),1),TOXPFTB(L,1,1) + ENDDO + ENDIF + CLOSE(LUNF) + ENDIF + IF(ICON.EQ.4)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),CONC(L,KC),CONC(L,1), + & SFLSBOT(L) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(885)=MPI_WTIMES(885)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISPHXY(ICON).EQ.2.AND.MYRANK.EQ.0)THEN + IF(ICON.LE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,KC) + & ,CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.GE.8)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,KC) + & ,CONC(L,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.6)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,1), + & SEDBT(L,KBT(L)),SEDF(L,0,1) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,KC) + & ,CONC(L,1),SEDBT(L,KBT(L)),SEDF(L,0,1) + ENDDO + ENDIF + ENDIF + IF(ICON.EQ.7)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,1), + & SNDBT(L,KBT(L)) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,KC) + & ,CONC(L,1),SNDBT(L,KBT(L)) + ENDDO + ENDIF + IF(NSND.GE.2)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN1,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,1,1), + & SNDB(L,KBT(L),1),SNDF(L,0,1),SNDFBL(L,1) + & ,CQBEDLOADX(L,1) + WRITE(LUN2,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,1,2), + & SNDB(L,KBT(L),2),SNDF(L,0,2),SNDFBL(L,2) + & ,CQBEDLOADX(L,2) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN1,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,KC,1), + & SND(L,1,1),SNDB(L,KBT(L),1),SNDF(L,0,1),SNDFBL(L,1), + & CQBEDLOADX(L,1) + WRITE(LUN2,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,KC,2), + & SND(L,1,2),SNDB(L,KBT(L),2),SNDF(L,0,2),SNDFBL(L,2), + & CQBEDLOADX(L,2) + ENDDO + ENDIF + ENDIF + IF(NSND.GE.3)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN3,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,1,NSND), + & SNDB(L,KBT(L),NSND),SNDF(L,0,NSND),SNDFBL(L,NSND), + & CQBEDLOADX(L,NSND) + ENDDO + ELSE + DO L=2,LA + WRITE(LUN3,200)IL(L),JL(L),DLON(L),DLAT(L),SND(L,KC,NSND), + & SND(L,1,NSND),SNDB(L,KBT(L),NSND), + & SNDF(L,0,NSND),SNDFBL(L,NSND),CQBEDLOADX(L,NSND) + ENDDO + ENDIF + ENDIF + ENDIF + IF(ICON.EQ.5)THEN + IF(KC.EQ.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),TOX(L,1,1), + & TOXB(L,KBT(L),1), + & TOXF(L,0,1),TOXFB(L,KBT(L),1) + WRITE(LUNF,200)IL(L),JL(L),DLON(L),DLAT(L),TOXPFTW(L,1,1), + & TOXPFTB(L,KBT(L),1) + ENDDO + ENDIF + IF(KC.GT.1)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),TOX(L,KC,1), + & TOX(L,1,1),TOXB(L,KBT(L),1),TOXB(L,1,1) + WRITE(LUNF,200)IL(L),JL(L),DLON(L),DLAT(L),TOXPFTW(L,KC,1), + & TOXPFTW(L,1,1),TOXPFTB(L,KBT(L),1),TOXPFTB(L,1,1) + ENDDO + ENDIF + CLOSE(LUNF) + ENDIF + IF(ICON.EQ.4)THEN + DO L=2,LA + WRITE(LUN,200)IL(L),JL(L),DLON(L),DLAT(L),CONC(L,KC), + & CONC(L,1),SFLSBOT(L) + ENDDO + ENDIF + ENDIF + MPI_WTIMES(886)=MPI_WTIMES(886)+MPI_TOC(S1TIME) + + S1TIME=MPI_TIC() + IF(ISPHXY(ICON).LE.2.AND.MYRANK.EQ.0)THEN + CLOSE(LUN) + IF(ICON.EQ.5)THEN + CLOSE(LUNF) + ENDIF + IF(ICON.EQ.7)THEN + IF(NSND.GE.2)THEN + CLOSE(LUN1) + CLOSE(LUN2) + ENDIF + IF(NSND.GE.3)THEN + CLOSE(LUN3) + ENDIF + ENDIF + ENDIF + MPI_WTIMES(887)=MPI_WTIMES(887)+MPI_TOC(S1TIME) + 99 FORMAT(A80) + 100 FORMAT(I10,F12.4) + 101 FORMAT(2I10) + 200 FORMAT(2I5,1X,8E14.6) +C 220 FORMAT(2I5,1X,13E11.3) + 400 FORMAT(1X,8E14.6) +C 420 FORMAT(1X,13E12.4) + 250 FORMAT(12E12.4) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH_mpi.for new file mode 100644 index 000000000..241a83db4 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SALTSMTH_mpi.for @@ -0,0 +1,93 @@ + SUBROUTINE SALTSMTH_mpi +C +C CHANGE RECORD +C + USE GLOBAL + USE MPI + IF(NSBMAX.GT.10) GOTO 1001 +C +C ELSE +C GOTO 1001 +C + DO K=1,KC + DO L=2,LA + TVAR3S(L)=SAL(L,K) + ENDDO + DO NSM=1,NSBMAX + DO L=2,LA + IF(LCT(L).GT.0.AND.LCT(L).LT.9)THEN + I=IL(L) + J=JL(L) + HTN=TVAR3S(LNC(L)) + HTS=TVAR3S(LSC(L)) + HTE=TVAR3S(L+1) + HTW=TVAR3S(L-1) + IF(IJCT(I ,J+1).EQ.9) HTN=TVAR3S(L) + IF(IJCT(I ,J-1).EQ.9) HTS=TVAR3S(L) + IF(IJCT(I+1,J ).EQ.9) HTE=TVAR3S(L) + IF(IJCT(I-1,J ).EQ.9) HTW=TVAR3S(L) + TVAR3N(L)=(1.-WSMB)*TVAR3S(L)+0.25*WSMB*(HTN+HTS+HTE+HTW) + ENDIF + ENDDO + DO L=2,LA + TVAR3S(L)=TVAR3N(L) + ENDDO + ENDDO + DO L=2,LA + SAL(L,K)=TVAR3N(L) + SAL1(L,K)=TVAR3N(L) + ENDDO + ENDDO + GOTO 2000 +C +C ** IMPLEMENT SPECIAL SALINITY INITIALIZATION, VERSION 1 +C 1000 CONTINUE +C ** IMPLEMENT SPECIAL SALINITY INITIALIZATION, VERSION 2 +C + 1001 CONTINUE + DO K=1,KC + DO L=2,LA + TVAR3S(L)=SAL(L,K) + ENDDO + DO NSM=1,NSBMAX + DO L=2,LA + LN=LNC(L) + LS=LSC(L) + TVAR3N(L)=TVAR3S(L)+(WSMB/HMP(L)) + & *( HRU(L+1)*(TVAR3S(L+1)-TVAR3S(L )) + & -HRU(L )*(TVAR3S(L )-TVAR3S(L-1)) + & +HRV(LN )*(TVAR3S(LN )-TVAR3S(L )) + & -HRV(L )*(TVAR3S(L )-TVAR3S(LS )) ) + ENDDO + DO L=2,LA + IF(SALINIT(L,K).GT.0.0) TVAR3N(L)=SALINIT(L,K) + ENDDO + DO L=2,LA + TVAR3S(L)=TVAR3N(L) + ENDDO + ENDDO + DO L=2,LA + SAL(L,K)=TVAR3N(L) + SAL1(L,K)=TVAR3N(L) + ENDDO + IF(MYRANK.EQ.0) WRITE(6,6001)K,NSM + ENDDO + IF(MYRANK.EQ.0)THEN + OPEN(1,FILE='NEWSALT.INP',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='NEWSALT.INP',STATUS='UNKNOWN') + IONE=1 + WRITE(1,9101)IONE + DO L=2,LC-1 + WRITE(1,9102)L,IL(L),JL(L),(SAL(L,K),K=1,KC) + ENDDO + CLOSE(1) + ENDIF +C6000 FORMAT(' COMPLE V1 SMOOTHING LAYER ',I5,' NSM = ',I5/) + 6001 FORMAT(' COMPLE V2 SMOOTHING LAYER ',I5,' NSM = ',I5/) + 9101 FORMAT(I5) + 9102 FORMAT(3I5,12F6.2) + 2000 CONTINUE + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETBCS_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETBCS_mpi.for new file mode 100644 index 000000000..66708b34a --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SETBCS_mpi.for @@ -0,0 +1,866 @@ + SUBROUTINE SETBCS_mpi +C +C CHANGE RECORD +C MODIFIED BOUNDARY CONDITION FLAGS FOR TYPE 2 OPEN BOUNDARIES +C ADDED REAL FLAGS RSSBCE(L),RSSBCW(L),RSSBCN(L),RSSBCS(L) +C TO MODIFIED CALCULATION OF CELL CENTER BED STRESS (STORED AS QQ(L,0)) +C AND THE OUTPUTED CELL CENTER VELOCITY FOR CELLS HAVE SOURCE/SINKS +C ** SUBROUTINE SETBCS SETS BOUNDARY CONDITION SWITCHES +C + USE GLOBAL + USE MPI + + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SUBEW + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVBNS + + IF(.NOT.ALLOCATED(SUBEW))THEN + ALLOCATE(SUBEW(LCM)) + ALLOCATE(SVBNS(LCM)) + SUBEW=0.0 + SVBNS=0.0 + ENDIF +C +C ** SET LAND-WATER BOUNDARY SWITCHES +C + ITRICELL=0 ! PMC + + DO L=2,LA + I=IL(L) + J=JL(L) + IF(LCT(L).EQ.1)THEN + STCUV(L)=0. + ITRICELL=1 + STCAP(L)=0.5 + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=1. + IF(IJCT(I-1,J).EQ.4) SUB(L)=1. + IF(IJCT(I-1,J).EQ.5) SUB(L)=1. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=1. + IF(IJCT(I,J-1).EQ.3) SVB(L)=1. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=1. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.2)THEN + STCUV(L)=0. + ITRICELL=1 + STCAP(L)=0.5 + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=1. + IF(IJCT(I-1,J).EQ.4) SUB(L)=1. + IF(IJCT(I-1,J).EQ.5) SUB(L)=1. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=0. + IF(IJCT(I,J-1).EQ.3) SVB(L)=0. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=0. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.3)THEN + STCUV(L)=0. + ITRICELL=1 + STCAP(L)=0.5 + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=0. + IF(IJCT(I-1,J).EQ.4) SUB(L)=0. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I-1,J).EQ.5) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=0. + IF(IJCT(I,J-1).EQ.3) SVB(L)=0. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=0. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.4)THEN + STCUV(L)=0. + ITRICELL=1 + STCAP(L)=0.5 + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=0. + IF(IJCT(I-1,J).EQ.4) SUB(L)=0. + IF(IJCT(I-1,J).EQ.5) SUB(L)=0. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=1. + IF(IJCT(I,J-1).EQ.3) SVB(L)=1. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=1. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.5)THEN + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=1. + IF(IJCT(I-1,J).EQ.4) SUB(L)=1. + IF(IJCT(I-1,J).EQ.5) SUB(L)=1. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=1. + IF(IJCT(I,J-1).EQ.3) SVB(L)=1. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=1. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.6)THEN + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=1. + IF(IJCT(I-1,J).EQ.4) SUB(L)=1. + IF(IJCT(I-1,J).EQ.5) SUB(L)=1. + IF(IJCT(I-1,J).EQ.6) SUB(L)=1. + IF(IJCT(I-1,J).EQ.7) SUB(L)=1. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=1. + IF(IJCT(I,J-1).EQ.3) SVB(L)=1. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=1. + IF(IJCT(I,J-1).EQ.6) SVB(L)=1. + IF(IJCT(I,J-1).EQ.7) SVB(L)=1. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + IF(LCT(L).EQ.7)THEN + IF(IJCT(I-1,J).EQ.1) SUB(L)=0. + IF(IJCT(I-1,J).EQ.2) SUB(L)=0. + IF(IJCT(I-1,J).EQ.3) SUB(L)=1. + IF(IJCT(I-1,J).EQ.4) SUB(L)=1. + IF(IJCT(I-1,J).EQ.5) SUB(L)=1. + IF(IJCT(I-1,J).EQ.6) SUB(L)=1. + IF(IJCT(I-1,J).EQ.7) SUB(L)=1. + IF(IJCT(I-1,J).EQ.9) SUB(L)=0. + IF(IJCT(I,J-1).EQ.1) SVB(L)=0. + IF(IJCT(I,J-1).EQ.2) SVB(L)=1. + IF(IJCT(I,J-1).EQ.3) SVB(L)=1. + IF(IJCT(I,J-1).EQ.4) SVB(L)=0. + IF(IJCT(I,J-1).EQ.5) SVB(L)=1. + IF(IJCT(I,J-1).EQ.6) SVB(L)=1. + IF(IJCT(I,J-1).EQ.7) SVB(L)=1. + IF(IJCT(I,J-1).EQ.9) SVB(L)=0. + ENDIF + ENDDO + SUB(1)=0. + SVB(1)=0. + SUB(LC)=0. + SVB(LC)=0. +C +C ** MODIFY LAND-WATER BNDRY CONDS FOR PERIOD GRID IN N-S DIRECTION +C + IF(ISPGNS.GE.1)THEN + DO NPN=1,NPNSBP + LS=LIJ(ISPNS(NPN),JSPNS(NPN)) + SVB(LS)=1. + SVBO(LS)=1. + ENDDO + ENDIF +C +C ** SET WATER-WATER (P OR SURFACE ELEVATION) BOUNDARY SWITCHES +C + DO LL=1,NPBW + I=IPBW(LL) + J=JPBW(LL) + L=LIJ(I,J) + LPBW(LL)=L + SPB(L)=0. ! *** Used for On/Off Rainfall/Evap + SUB(L)=0. + SVB(L)=0. + SWB(L)=0. ! *** Used for On/Off of Vertical Velocities + SAAX(L)=0. ! *** Used for On/Off of Horizontal Momentum Stresses (X Dir) PMC-Added + SAAY(L)=0. ! *** Used for On/Off of Horizontal Momentum Stresses (Y Dir) PMC-Added + IF(ISPBW(LL).LE.1) THEN + SVB(L+1)=0. + SWB(L+1)=0. + SCAX(L+1)=0. ! *** Used for On/Off of Coriolis & Curvature Stresses + END IF + SAAX(L+1)=0. ! *** Used for On/Off of Horizontal Momentum Stresses (X Dir) + SAAY(L+1)=0. ! *** Used for On/Off of Horizontal Momentum Stresses (Y Dir) PMC-Added + !SDX(L+1)=0. ! *** Used for On/Off of Horizontal Momentum Diffusion Stresses PMC-Disabled + ENDDO + DO LL=1,NPBE + I=IPBE(LL) + J=JPBE(LL) + L=LIJ(I,J) + LPBE(LL)=L + SPB(L)=0. + SVB(L)=0. + SWB(L)=0. + IF(ISPBE(LL).LE.1) THEN + SWB(L-1)=0. + SVB(L-1)=0. + SCAX(L)=0. + END IF + SAAY(L)=0. ! PMC + SAAX(L)=0. + !SDX(L)=0. + ENDDO + DO LL=1,NPBS + I=IPBS(LL) + J=JPBS(LL) + L=LIJ(I,J) + LPBS(LL)=L + LN=LNC(L) + SPB(L)=0. + SVB(L)=0. + SUB(L)=0. + SWB(L)=0. + IF(ISPBS(LL).LE.1) THEN + SUB(LN)=0. + SWB(LN)=0. + SCAY(LN)=0. + END IF + SAAX(L)=0. ! PMC + SAAY(L)=0. ! PMC + SAAX(LN)=0. ! PMC + SAAY(LN)=0. + !SDY(LN)=0. + ENDDO + DO LL=1,NPBN + I=IPBN(LL) + J=JPBN(LL) + L=LIJ(I,J) + LPBN(LL)=L + LS=LSC(L) + SPB(L)=0. + SUB(L)=0. + SWB(L)=0. + IF(ISPBN(LL).LE.1) THEN + SUB(LS)=0. + SWB(LS)=0. + SCAY(L)=0. + END IF + SAAX(L)=0. ! PMC + SAAY(L)=0. + !SDY(L)=0. + ENDDO +C +C ********************************************************************* +C *** SET THE CELL FACES SWITCHES FOR HEAD CONTROL STRUCTURES + ! *** UPSTREAM CONTROL + DO NCTL=1,NQCTL + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + L=LIJ(IU,JU) + + ! *** SET U FACE + LW=L-1 + DO IQ=1,NQCTL + IF(IQ.NE.NCTL)THEN + I=IQCTLU(IQ) + J=JQCTLU(IQ) + L1=LIJ(I,J) + IF(L1.EQ.LW)THEN + SUB(L)=0.0 + EXIT + ENDIF + ENDIF + ENDDO + + ! *** SET V FACE + LS=LSC(L) + DO IQ=1,NQCTL + IF(IQ.NE.NCTL)THEN + I=IQCTLU(IQ) + J=JQCTLU(IQ) + L1=LIJ(I,J) + IF(L1.EQ.LS)THEN + SVB(L)=0.0 + EXIT + ENDIF + ENDIF + ENDDO + ENDDO + + ! *** DOWNSTREAM CONTROL + DO NCTL=1,NQCTL + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.NE.0.AND.JD.NE.0)THEN + L=LIJ(ID,JD) + + ! *** SET U FACE + LW=L-1 + DO IQ=1,NQCTL + IF(IQ.NE.NCTL)THEN + I=IQCTLD(IQ) + J=JQCTLD(IQ) + IF(I.GT.0.AND.J.GT.0)THEN ! PMC + L1=LIJ(I,J) + IF(L1.EQ.LW)THEN + SUB(L)=0.0 + EXIT + ENDIF + ENDIF + ENDIF + ENDDO + + ! *** SET V FACE + LS=LSC(L) + DO IQ=1,NQCTL + IF(IQ.NE.NCTL)THEN + I=IQCTLD(IQ) + J=JQCTLD(IQ) + IF(I.GT.0.AND.J.GT.0)THEN ! PMC + L1=LIJ(I,J) + IF(L1.EQ.LS)THEN + SVB(L)=0.0 + EXIT + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF + ENDDO +C +C ** RESET DXU,DYU,DXV,DYV BASED ON BOUNDARY CONDITION SWITCHES +C + DO L=2,LA + IF(SUB(L).GT.0.5)THEN + DXU(L)=0.5*(DXP(L)+DXP(L-1)) + DYU(L)=0.5*(DYP(L)+DYP(L-1)) + ENDIF + IF(SUB(L).LT.0.5.AND.SUB(L+1).GT.0.5)THEN + DXU(L)=DXP(L) + DDYDDDX=2.*(DYP(L+1)-DYP(L))/(DXP(L)+DXP(L+1)) + DYU(L)=DYP(L)-0.5*DXP(L)*DDYDDDX + ENDIF + IF(SUB(L).LT.0.5.AND.SUB(L+1).LT.0.5)THEN + DXU(L)=DXP(L) + DYU(L)=DYP(L) + ENDIF + ENDDO + DO L=2,LA + LN=LNC(L) + LS=LSC(L) + IF(SVB(L).GT.0.5)THEN + DXV(L)=0.5*(DXP(L)+DXP(LS)) + DYV(L)=0.5*(DYP(L)+DYP(LS)) + ENDIF + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + DDXDDDY=2.*(DXP(LN)-DXP(L))/(DYP(L)+DYP(LN)) + DXV(L)=DXP(L)-0.5*DYP(L)*DDXDDDY + DYV(L)=DYP(L) + ENDIF + IF(SVB(L).LT.0.5.AND.SVB(LN).LT.0.5)THEN + DXV(L)=DXP(L) + DYV(L)=DYP(L) + ENDIF + ENDDO +C +C ** SET THIN BARRIERS BY CALLING CELLMASK +C ** CALL MOVED FROM AAEFDC ON 23 JAN 2004 +C + IF(ISMASK.EQ.1) CALL CELLMASK +C +C ** SET VOLUMETRIC & CONCENTRATION SOURCE LOCATIONS AND BED STRESS +C ** AND CELL CENTER BED STRESS AND VELOCITY MODIFERS +C + DO LL=1,NQSIJ + I=IQS(LL) + J=JQS(LL) + LTMP=LIJ(I,J) + LQS(LL)=LTMP + IF(NQSMUL(LL).EQ.0)RQSMUL(LL)=1. + IF(NQSMUL(LL).EQ.1)RQSMUL(LL)=DYP(LTMP) + IF(NQSMUL(LL).EQ.2)RQSMUL(LL)=DXP(LTMP) + IF(NQSMUL(LL).EQ.3)RQSMUL(LL)=DXP(LTMP)+DYP(LTMP) + ENDDO + DO NCTL=1,NQCTL + RQDW=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + LTMP=LIJ(IU,JU) + IF(NQCMUL(NCTL).EQ.0)RQCMUL(NCTL)=1. + IF(NQCMUL(NCTL).EQ.1)RQCMUL(NCTL)=DYP(LTMP) + IF(NQCMUL(NCTL).EQ.2)RQCMUL(NCTL)=DXP(LTMP) + IF(NQCMUL(NCTL).EQ.3)RQCMUL(NCTL)=DXP(LTMP)+DYP(LTMP) + ENDDO +C +C ********************************************************************* +C *** SET THE VELOCITY AVERAGING FACTORS + + ! *** DEFAULT CONDITION + DO L=2,LA + RSSBCE(L)=1.0 + RSSBCW(L)=1.0 + RSSBCN(L)=1.0 + RSSBCS(L)=1.0 + SUBEW(L)=SUB(L)+SUB(L+1) + SVBNS(L)=SVB(L)+SVB(LNC(L)) + ENDDO + + ! *** FLOW BOUNDARY CONDITIONS + DO LL=1,NQSIJ + L=LQS(LL) + LE=L+1 + LN=LNC(L) + IF(SUBEW(L).LT.1.5)THEN + IF(SUB(L).LT.0.5.AND.SUB(LE).GT.0.5)THEN + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ENDIF + IF(SUB(L).GT.0.5.AND.SUB(LE).LT.0.5)THEN + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ENDIF + ENDIF + IF(SVBNS(L).LT.1.5)THEN + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ENDIF + IF(SVB(L).GT.0.5.AND.SVB(LN).LT.0.5)THEN + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ENDIF + ENDIF + ENDDO + + ! *** WEIR STRUCTURE: UPSTREAM + DO NCTL=1,NQCTL + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + L=LIJ(IU,JU) + LE=L+1 + LN=LNC(L) + IF(SUBEW(L).LT.1.5)THEN + IF(SUB(L).LT.0.5.AND.SUB(LE).GT.0.5)THEN + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ENDIF + IF(SUB(L).GT.0.5.AND.SUB(LE).LT.0.5)THEN + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ENDIF + ENDIF + IF(SVBNS(L).LT.1.5)THEN + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ENDIF + IF(SVB(L).GT.0.5.AND.SVB(LN).LT.0.5)THEN + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ENDIF + ENDIF + ENDDO + + ! *** WEIR STRUCTURE: DOWNSTREAM + DO NCTL=1,NQCTL + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.NE.0.AND.JD.NE.0)THEN + L=LIJ(ID,JD) + LE=L+1 + LN=LNC(L) + IF(SUBEW(L).LT.1.5)THEN + IF(SUB(L).LT.0.5.AND.SUB(LE).GT.0.5)THEN + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ENDIF + IF(SUB(L).GT.0.5.AND.SUB(LE).LT.0.5)THEN + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ENDIF + ENDIF + IF(SVBNS(L).LT.1.5)THEN + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ENDIF + IF(SVB(L).GT.0.5.AND.SVB(LN).LT.0.5)THEN + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ENDIF + ENDIF + END IF + ENDDO + + ! *** GLOBAL BOUNDARY CELL LIST + NBCS=0 + + ! *** WITHDRAWAL & RETURN BOUNDARY CONDITIONS: UPSTREAM + DO NWR=1,NQWR + IU=IQWRU(NWR) + JU=JQWRU(NWR) + L=LIJ(IU,JU) + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=1 + LBNRC(NBCS)=1 + LE=L+1 + LN=LNC(L) + IF(SUBEW(L).LT.1.5)THEN + IF(SUB(L).LT.0.5.AND.SUB(LE).GT.0.5)THEN + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ENDIF + IF(SUB(L).GT.0.5.AND.SUB(LE).LT.0.5)THEN + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ENDIF + ENDIF + IF(SVBNS(L).LT.1.5)THEN + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ENDIF + IF(SVB(L).GT.0.5.AND.SVB(LN).LT.0.5)THEN + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ENDIF + ENDIF + ENDDO + + ! *** WITHDRAWAL & RETURN BOUNDARY CONDITIONS: DOWNSTREAM + DO NWR=1,NQWR + ID=IQWRD(NWR) + JD=JQWRD(NWR) + L=LIJ(ID,JD) + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=1 + LBNRC(NBCS)=1 + LE=L+1 + LN=LNC(L) + IF(SUBEW(L).LT.1.5)THEN + IF(SUB(L).LT.0.5.AND.SUB(LE).GT.0.5)THEN + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ENDIF + IF(SUB(L).GT.0.5.AND.SUB(LE).LT.0.5)THEN + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ENDIF + ENDIF + IF(SVBNS(L).LT.1.5)THEN + IF(SVB(L).LT.0.5.AND.SVB(LN).GT.0.5)THEN + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ENDIF + IF(SVB(L).GT.0.5.AND.SVB(LN).LT.0.5)THEN + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ENDIF + ENDIF + ENDDO + + ! *** SET BOUNDARY MOMENTUM SWITCHES FOR FLOW & HEAD CONTROL + + ! *** FLOW BC'S + DO LL=1,NQSIJ + I=IQS(LL) + J=JQS(LL) + L=LIJ(I,J) + NBCS=NBCS+1 + LBCS(NBCS)=L + + ! *** SET SAAX & SAAY FOR BOUNDARY MOMENTUM FLUXES + ! *** EAST/WEST MOMENTUM + LBERC(NBCS)=L + IF(SUB(L).LT.0.5)THEN + SAAX(L)=0. + SAAY(L)=0. + ENDIF + IF(L.LT.LA-2)THEN + IF(SUB(L).LT.0.5.AND.(SUB(L+1).GT.0.5.AND.SUB(L+2).GT.0.5)) + & THEN + LBERC(NBCS)=L+1 + SAAX(LBERC(NBCS))=0. + SAAY(LBERC(NBCS))=0. + ENDIF + ENDIF + IF(L.GT.2.AND.L.LT.LA)THEN + IF((SUB(L ).GT.0.5.AND.SUB(L+1).LT.0.5).AND. + & (SUB(L-1).GT.0.5.AND.SUB(L-2).GT.0.5))THEN + LBERC(NBCS)=L-1 + SAAX(LBERC(NBCS))=0. + SAAY(LBERC(NBCS))=0. + SAAX(L)=0. + SAAY(L)=0. + ENDIF + ENDIF + ! *** NORTH/SOUTH MOMENTUM + LBNRC(NBCS)=L + IF(SVB(L).LT.0.5)THEN + SAAX(L)=0. + SAAY(L)=0. + ENDIF + IF(SVB(L).LT.0.5.AND.(SVB(LNC(L)).GT.0.5.AND. + & SVB(LNC(LNC(L))).GT.0.5))THEN + LBNRC(NBCS)=LNC(L) + SAAX(LBNRC(NBCS))=0. + SAAY(LBNRC(NBCS))=0. + ENDIF + IF((SVB(L ).GT.0.5.AND.SVB(LNC(L)).LT.0.5).AND. + & (SVB(LSC(L)).GT.0.5.AND.SVB(LSC(LSC(L))).GT.0.5))THEN + LBNRC(NBCS)=LSC(L) + SAAX(LBNRC(NBCS))=0. + SAAY(LBNRC(NBCS))=0. + SAAX(L)=0. + SAAY(L)=0. + ENDIF + + ENDDO + + ! *** HEAD CONTROL: UPSTREAM + DO NCTL=1,NQCTL + RQDW=1. + IU=IQCTLU(NCTL) + JU=JQCTLU(NCTL) + L=LIJ(IU,JU) + NBCS=NBCS+1 + LBCS(NBCS)=L + + ! *** SET SAAX & SAAY FOR BOUNDARY MOMENTUM FLUXES + ! *** EAST/WEST MOMENTUM + LBERC(NBCS)=L + IF(SUB(L).LT.0.5)THEN + SAAX(L)=0. + SAAY(L)=0. ! PMC + ENDIF +c IF(SUB(L).LT.0.5.AND.(SUB(L+1).GT.0.5.AND.SUB(L+2).GT.0.5))THEN +c LBERC(NBCS)=L+1 +c SAAX(LBERC(NBCS))=0. +c SAAY(LBERC(NBCS))=0. +c ENDIF + if(L>=3)then ! added to avoid SUB(0) + IF((SUB(L ).GT.0.5.AND.SUB(L+1).LT.0.5).AND. + & (SUB(L-1).GT.0.5.AND.SUB(L-2).GT.0.5))THEN + LBERC(NBCS)=L-1 + SAAX(LBERC(NBCS))=0. + SAAY(LBERC(NBCS))=0. + SAAX(L)=0. + SAAY(L)=0. + ENDIF + endif + ! *** NORTH/SOUTH MOMENTUM + LBNRC(NBCS)=L + IF(SVB(L).LT.0.5)THEN + SAAX(L)=0. + SAAY(L)=0. + ENDIF +c IF(SVB(L).LT.0.5.AND.(SVB(LNC(L)).GT.0.5.AND. +c & SVB(LNC(LNC(L))).GT.0.5))THEN +c LBNRC(NBCS)=LNC(L) +c SAAX(LBNRC(NBCS))=0. +c SAAY(LBNRC(NBCS))=0. +c ENDIF + IF((SVB(L ).GT.0.5.AND.SVB(LNC(L)).LT.0.5).AND. + & (SVB(LSC(L)).GT.0.5.AND.SVB(LSC(LSC(L))).GT.0.5))THEN + LBNRC(NBCS)=LSC(L) + SAAX(LBNRC(NBCS))=0. + SAAY(LBNRC(NBCS))=0. + SAAX(L)=0. + SAAY(L)=0. + ENDIF + + ENDDO + + ! *** HEAD CONTROL: DOWNSTREAM + DO NCTL=1,NQCTL + ID=IQCTLD(NCTL) + JD=JQCTLD(NCTL) + IF(ID.NE.0.AND.JD.NE.0)THEN + L=LIJ(ID,JD) + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=1 + LBNRC(NBCS)=1 + ENDIF + ENDDO + + ! *** SET BOUNDARY VELOCITY SWITCHES + ! *** OPEN BOUNDARIES + NBCSOP=0 + DO LL=1,NPBS + I=IPBS(LL) + J=JPBS(LL) + L=LIJ(I,J) + RSSBCS(L)=0.0 + RSSBCN(L)=2.0 + ! *** SAVE THE L'S + NBCSOP=NBCSOP+1 + LOBCS(NBCSOP)=L + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=L ! PMC-CHANGE THE NAME OF LBERC TO LBCE + LBNRC(NBCS)=LNC(L) ! PMC-CHANGE THE NAME OF LBNRC TO LBCN + ENDDO + DO LL=1,NPBW + I=IPBW(LL) + J=JPBW(LL) + L=LIJ(I,J) + RSSBCW(L)=0.0 + RSSBCE(L)=2.0 + ! *** SAVE THE L'S + NBCSOP=NBCSOP+1 + LOBCS(NBCSOP)=L + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=L+1 + LBNRC(NBCS)=L + ENDDO + DO LL=1,NPBE + I=IPBE(LL) + J=JPBE(LL) + L=LIJ(I,J) + RSSBCW(L)=2.0 + RSSBCE(L)=0.0 + ! *** SAVE THE L'S + NBCSOP=NBCSOP+1 + LOBCS(NBCSOP)=L + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=L-1 + LBNRC(NBCS)=L + ENDDO + DO LL=1,NPBN + I=IPBN(LL) + J=JPBN(LL) + L=LIJ(I,J) + RSSBCS(L)=2.0 + RSSBCN(L)=0.0 + ! *** SAVE THE L'S + NBCSOP=NBCSOP+1 + LOBCS(NBCSOP)=L + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=L + LBNRC(NBCS)=LSC(L) + ENDDO +C +C ********************************************************************* +C *** SET OPEN BOUNDARY FLAGS FOR CONSTITUENTS + DO LL=1,NCBS + I=ICBS(LL) + J=JCBS(LL) + LCBS(LL)=LIJ(I,J) + L=LIJ(I,J) + SCB(L)=0. + ENDDO + DO LL=1,NCBW + I=ICBW(LL) + J=JCBW(LL) + LCBW(LL)=LIJ(I,J) + L=LIJ(I,J) + SCB(L)=0. + ENDDO + DO LL=1,NCBE + I=ICBE(LL) + J=JCBE(LL) + LCBE(LL)=LIJ(I,J) + L=LIJ(I,J) + SCB(L)=0. + ENDDO + DO LL=1,NCBN + I=ICBN(LL) + J=JCBN(LL) + LCBN(LL)=LIJ(I,J) + L=LIJ(I,J) + SCB(L)=0. + ENDDO + +C ********************************************************************* +C *** SET JET-PLUME VOLUMES SOURCES + DO NJP=1,NQJPIJ + L=LIJ(IQJP(NJP),JQJP(NJP)) + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=1 + LBNRC(NBCS)=1 + + IF(ICALJP(NJP).EQ.2)THEN + ! *** WITHDRAWAL CELL + L=LIJ(IUPCJP(NJP),JUPCJP(NJP)) + NBCS=NBCS+1 + LBCS(NBCS)=L + LBERC(NBCS)=1 + LBNRC(NBCS)=1 + ENDIF + ENDDO + +C +C ** SET CHANNEL HOST AND GUEST LOCATION MAPPINGS +C + IF(MDCHH.GE.1)THEN + DO NMD=1,MDCHH + L=LIJ(IMDCHH(NMD),JMDCHH(NMD)) + LMDCHH(NMD)=L + NBCS=NBCS+1 + LBCS(NBCS)=L + IF(IMDCHU(NMD).EQ.1.AND.JMDCHU(NMD).EQ.1)THEN + LMDCHU(NMD)=1 + ELSE + L=LIJ(IMDCHU(NMD),JMDCHU(NMD)) + LMDCHU(NMD)=L + ENDIF + IF(IMDCHV(NMD).EQ.1.AND.JMDCHV(NMD).EQ.1)THEN + LMDCHV(NMD)=1 + ELSE + L=LIJ(IMDCHV(NMD),JMDCHV(NMD)) + LMDCHV(NMD)=L + ENDIF + NBCS=NBCS+1 + LBCS(NBCS)=L + ENDDO + ENDIF +C +C ** SET CELL FACE WET DEPTHS +C + HUWET(1)=HWET + HUWET(LC)=HWET + HVWET(1)=HWET + HVWET(LC)=HWET + HUDRY(1)=HDRY + HUDRY(LC)=HDRY + HVDRY(1)=HDRY + HVDRY(LC)=HDRY + DO L=2,LA + LS=LSC(L) + HUDRY(L)=HDRY+0.5*ABS(BELV(L)-BELV(L-1)) + HVDRY(L)=HDRY+0.5*ABS(BELV(L)-BELV(LS)) + HUWET(L)=HWET+0.5*ABS(BELV(L)-BELV(L-1)) + HVWET(L)=HWET+0.5*ABS(BELV(L)-BELV(LS)) + ENDDO + IF(ISDRY.GT.0)THEN + NDRYTMP=MOD(ISDRY,2) + IF(NDRYTMP.NE.0)THEN + DO L=2,LA + HUWET(L)=HWET + HVWET(L)=HWET + HUDRY(L)=HDRY + HVDRY(L)=HDRY + ENDDO + ENDIF + ENDIF +C +C *** SET PERMANENT FACE SWITCHES +C + DO L=1,LC + SUBO(L)=SUB(L) + SVBO(L)=SVB(L) + ENDDO +C +C ** DIAGNOSTIC OUTPUT +C + IF(DEBUG.AND.MYRANK.EQ.0)THEN + OPEN(1,FILE='SETBC.DIA',STATUS='UNKNOWN') + CLOSE(1,STATUS='DELETE') + OPEN(1,FILE='SETBC.DIA') + DO L=2,LA + WRITE(1,1001)IL(L),JL(L),SUB(L),SUB(L+1),SVB(L),SVB(LNC(L)), + & SPB(L) + ENDDO + CLOSE(1) + ENDIF + 1001 FORMAT(2I5,8E13.4) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VELPLTH_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VELPLTH_mpi.for new file mode 100644 index 000000000..bdf70efdd --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VELPLTH_mpi.for @@ -0,0 +1,402 @@ + SUBROUTINE VELPLTH_mpi +C +C CHANGE RECORD +C ADDED REAL FLAGS RSSBCE(L),RSSBCW(L),RSSBCN(L),RSSBCS(L) +C TO MODIFIED THE OUTPUTED CELL CENTER VELOCITY FOR CELLS HAVE SOURCE/ +C ** SUBROUTINE VELPLTH WRITES A HORIZONTAL INSTANTANEOUS VELOCITY +C ** VECTOR FILE +C + USE GLOBAL + USE MPI + INTEGER*4 VER + DIMENSION DBS(10) + CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE4,TITLE5,TITLE6,TITLE7 +C + call collect_in_zero_array(U) + call collect_in_zero_array(V) + call collect_in_zero_array(W) +C + IF(MYRANK.EQ.0)THEN + IF(IVPHXY.LE.2)THEN + IF(JSVPH.NE.1)GOTO 300 +C +C ** WRITE HEADINGS +C + TITLE1='INSTANTANEOUS HORIZ VELOCITY CM/S ' + TITLE2='INSTANTANEOUS BOTTOM STRESS CM2/S2' + TITLE3='BEDLOAD TRANSPORT KG/S' + TITLE4='DEPTH INTEGRAED SED TRANS KG/S' + TITLE5='EFFECTIVE BOTTOM ROUGHNESS CM' + TITLE6='CURRENT SHEAR VELOCITY CM/S' + TITLE7='WAVE-CURRENT SHEAR VELOCITY CM/S' + IF(ISVPH.EQ.1) LINES1=LA-1 + IF(ISVPH.EQ.2) LINES1=NRC + IF(ISVPH.EQ.3) LINES1=NBC + LEVELS=2 + LEVELT=1 + DBS(1)=0. + DBS(2)=99. + OPEN(10,FILE='VELVECH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='VELVECH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE1 + WRITE (10,101)LINES1,LEVELS + WRITE (10,250)(DBS(L),L=1,LEVELS) + CLOSE(10) + OPEN(11,FILE='VELVECH.COC',STATUS='UNKNOWN') + CLOSE(11,STATUS='DELETE') + OPEN(11,FILE='VELVECH.COC',STATUS='UNKNOWN') + WRITE (11,99) TITLE1 + WRITE (11,101)LINES1,LEVELS + WRITE (11,250)(DBS(L),L=1,LEVELS) + CLOSE(11) + OPEN(10,FILE='TAUVECH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='TAUVECH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE2 + WRITE (10,101)LINES1,LEVELT + WRITE (10,250)(DBS(L),L=1,LEVELT) + CLOSE(10) + IF(ISTRAN(7).GT.0)THEN + OPEN(10,FILE='SBLVECH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='SBLVECH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE3 + WRITE (10,101)LINES1,LEVELS + WRITE (10,250)(DBS(L),L=1,LEVELS) + CLOSE(10) + ENDIF + IF(ISWAVE.GE.1)THEN + OPEN(10,FILE='ZBREFFH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='ZBREFFH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE5 + WRITE (10,101)LINES1,LEVELT + WRITE (10,250)(DBS(L),L=1,LEVELT) + CLOSE(10) + ENDIF + IF(ISWAVE.GE.1)THEN + OPEN(10,FILE='CCUSTRH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='CCUSTRH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE6 + WRITE (10,101)LINES1,LEVELT + WRITE (10,250)(DBS(L),L=1,LEVELT) + CLOSE(10) + ENDIF + IF(ISWAVE.GE.1)THEN + OPEN(10,FILE='WCUSTRH.OUT',STATUS='UNKNOWN') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='WCUSTRH.OUT',STATUS='UNKNOWN') + WRITE (10,99) TITLE7 + WRITE (10,101)LINES1,LEVELT + WRITE (10,250)(DBS(L),L=1,LEVELT) + CLOSE(10) + ENDIF + JSVPH=0 + 300 CONTINUE + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + TIME=TIME/TCON + ELSE + TIME=TIMESEC/TCON + ENDIF + OPEN(10,FILE='VELVECH.OUT',POSITION='APPEND') + WRITE (10,100)N,TIME + OPEN(11,FILE='TAUVECH.OUT',POSITION='APPEND') + WRITE (11,100)N,TIME + IF(ISTRAN(7).GT.0)THEN + OPEN(12,FILE='SBLVECH.OUT',POSITION='APPEND') + WRITE (12,100)N,TIME + ENDIF + IF(ISWAVE.GE.1)THEN + OPEN(14,FILE='ZBREFFH.OUT',POSITION='APPEND') + WRITE (14,100)N,TIME + OPEN(15,FILE='CCUSTRH.OUT',POSITION='APPEND') + WRITE (15,100)N,TIME + OPEN(16,FILE='WCUSTRH.OUT',POSITION='APPEND') + WRITE (16,100)N,TIME + ENDIF + OPEN(20,FILE='VELVECH.COC',POSITION='APPEND') + WRITE (20,100)N,TIME + QBOTTMP=100./CTURB3 + IF(IVPHXY.EQ.0)THEN + DO L=2,LA + LN=LNC(L) + UTMPS=50.*STCUV(L)*(RSSBCE(L)*U(L+1,KC)+RSSBCW(L)*U(L,KC)) + VTMPS=50.*STCUV(L)*(RSSBCN(L)*V(LN ,KC)+RSSBCS(L)*V(L,KC)) + VELEKC=CUE(L)*UTMPS+CVE(L)*VTMPS + VELNKC=CUN(L)*UTMPS+CVN(L)*VTMPS + UTMPB=50.*STCUV(L)*(RSSBCE(L)*U(L+1,1)+RSSBCW(L)*U(L,1)) + VTMPB=50.*STCUV(L)*(RSSBCN(L)*V(LN ,1)+RSSBCS(L)*V(L,1)) + VELEKB=CUE(L)*UTMPB+CVE(L)*VTMPB + VELNKB=CUN(L)*UTMPB+CVN(L)*VTMPB + UTMPA=50.*STCUV(L)*(RSSBCE(L)*UHE(L+1)*HUI(L+1) + & +RSSBCW(L)*UHE(L)*HUI(L)) + VTMPA=50.*STCUV(L)*(RSSBCN(L)*VHE(LN )*HVI(LN ) + & +RSSBCS(L)*VHE(L)*HVI(L)) + TUTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + TVTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEAV=CUE(L)*UTMPA+CVE(L)*VTMPA + VELNAV=CUN(L)*UTMPA+CVN(L)*VTMPA +C +C WRITE VELVECH.OUT +C + IF(KC.GT.1)WRITE(10,201) + & VELEKC,VELNKC,VELEKB,VELNKB,VELEAV,VELNAV + IF(KC.EQ.1)WRITE(10,200)IL(L),JL(L),VELEKB,VELNKB +C +C WRITE VELVECH.COC +C + IF(KC.GT.1)WRITE(20,201) + & UTMPS,VTMPS,UTMPB,VTMPB,UTMPA,VTMPA,TUTMP,TVTMP + IF(KC.EQ.1)WRITE(20,200)IL(L),JL(L),UTMPS,VTMPS,TUTMP,TVTMP + UTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + VTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + TMPV1=10000.*TAUB(L) + TMPV2=10000.*TAUBSED(L) + TMPV3=10000.*TAUBSND(L) +C +C WRITE TAUVECH.OUT +C + WRITE(11,201)VELEKC,VELNKC,TMPV1,TMPV2,TMPV3 + IF(ISTRAN(7).GE.1) THEN + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,1) + & +RSSBCW(L)*QSBDLDX(L ,1)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,1) + & +RSSBCS(L)*QSBDLDY(L ,1)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,2) + & +RSSBCW(L)*QSBDLDX(L,2)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,2) + & +RSSBCS(L)*QSBDLDY(L,2)) + VELEKB=CUE(L)*UTMP+CVE(L)*VTMP + VELNKB=CUN(L)*UTMP+CVN(L)*VTMP + WRITE(12,200)VELEKC,VELNKC, + & VELEKB,VELNKB + END IF + IF(ISWAVE.EQ.2)THEN + ZBREFF=100.*ZBRE(L) + WRITE(14,201)ZBREFF + QTURBC=QBOTTMP*QQSQR(L,0) + WRITE(15,201)QTURBC + QTURBC=QBOTTMP*QQWV2(L) + WRITE(16,201)QTURBC + ENDIF + ENDDO + ENDIF + IF(IVPHXY.EQ.1)THEN + DO L=2,LA + LN=LNC(L) + UTMPS=50.*STCUV(L)*(RSSBCE(L)*U(L+1,KC)+RSSBCW(L)*U(L,KC)) + VTMPS=50.*STCUV(L)*(RSSBCN(L)*V(LN ,KC)+RSSBCS(L)*V(L,KC)) + VELEKC=CUE(L)*UTMPS+CVE(L)*VTMPS + VELNKC=CUN(L)*UTMPS+CVN(L)*VTMPS + UTMPB=50.*STCUV(L)*(RSSBCE(L)*U(L+1,1)+RSSBCW(L)*U(L,1)) + VTMPB=50.*STCUV(L)*(RSSBCN(L)*V(LN ,1)+RSSBCS(L)*V(L,1)) + VELEKB=CUE(L)*UTMPB+CVE(L)*VTMPB + VELNKB=CUN(L)*UTMPB+CVN(L)*VTMPB + UTMPA=50.*STCUV(L)*(RSSBCE(L)*UHE(L+1)*HUI(L+1) + & +RSSBCW(L)*UHE(L)*HUI(L)) + VTMPA=50.*STCUV(L)*(RSSBCN(L)*VHE(LN )*HVI(LN ) + & +RSSBCS(L)*VHE(L)*HVI(L)) + TUTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + TVTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEAV=CUE(L)*UTMPA+CVE(L)*VTMPA + VELNAV=CUN(L)*UTMPA+CVN(L)*VTMPA +C +C WRITE VELVECH.OUT +C + IF(KC.GT.1)WRITE(10,200)IL(L),JL(L), + & VELEKC,VELNKC,VELEKB,VELNKB,VELEAV,VELNAV + IF(KC.EQ.1)WRITE(10,200)IL(L),JL(L),VELEKB,VELNKB +C +C WRITE VELVECH.COC +C + IF(KC.GT.1)WRITE(20,200)IL(L),JL(L), + & UTMPS,VTMPS,UTMPB,VTMPB,UTMPA,VTMPA,TUTMP,TVTMP + IF(KC.EQ.1)WRITE(20,200)IL(L),JL(L),UTMPS,VTMPS,TUTMP,TVTMP + UTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + VTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + TMPV1=10000.*TAUB(L) + TMPV2=10000.*TAUBSED(L) + TMPV3=10000.*TAUBSND(L) +C +C WRITE TAUVECH.OUT +C + WRITE(11,200)IL(L),JL(L),VELEKC,VELNKC,TMPV1,TMPV2,TMPV3 + IF(ISTRAN(7).GE.1) THEN + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,1) + & +RSSBCW(L)*QSBDLDX(L ,1)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,1) + & +RSSBCS(L)*QSBDLDY(L ,1)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,2) + & +RSSBCW(L)*QSBDLDX(L,2)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,2) + & +RSSBCS(L)*QSBDLDY(L,2)) + VELEKB=CUE(L)*UTMP+CVE(L)*VTMP + VELNKB=CUN(L)*UTMP+CVN(L)*VTMP + WRITE(12,200)IL(L),JL(L),VELEKC,VELNKC, + & VELEKB,VELNKB + END IF + IF(ISWAVE.EQ.2)THEN + ZBREFF=100.*ZBRE(L) + WRITE(14,200)IL(L),JL(L),DLON(L),DLAT(L),ZBREFF + QTURBC=QBOTTMP*QQSQR(L,0) + WRITE(15,200)IL(L),JL(L),DLON(L),DLAT(L),QTURBC + QTURBC=QBOTTMP*QQWV2(L) + WRITE(16,200)IL(L),JL(L),DLON(L),DLAT(L),QTURBC + ENDIF + ENDDO + ENDIF + !IF(IVPHXY.EQ.2)THEN + !END IF +![ykchoi(10.05.10.) for IVPHXY==2 + IF(IVPHXY.EQ.2)THEN + DO L=2,LA + LN=LNC(L) + UTMPS=50.*STCUV(L)*(RSSBCE(L)*U(L+1,KC)+RSSBCW(L)*U(L,KC)) + VTMPS=50.*STCUV(L)*(RSSBCN(L)*V(LN ,KC)+RSSBCS(L)*V(L,KC)) + VELEKC=CUE(L)*UTMPS+CVE(L)*VTMPS + VELNKC=CUN(L)*UTMPS+CVN(L)*VTMPS + UTMPB=50.*STCUV(L)*(RSSBCE(L)*U(L+1,1)+RSSBCW(L)*U(L,1)) + VTMPB=50.*STCUV(L)*(RSSBCN(L)*V(LN ,1)+RSSBCS(L)*V(L,1)) + VELEKB=CUE(L)*UTMPB+CVE(L)*VTMPB + VELNKB=CUN(L)*UTMPB+CVN(L)*VTMPB + UTMPA=50.*STCUV(L)*(RSSBCE(L)*UHE(L+1)*HUI(L+1) + & +RSSBCW(L)*UHE(L)*HUI(L)) + VTMPA=50.*STCUV(L)*(RSSBCN(L)*VHE(LN )*HVI(LN ) + & +RSSBCS(L)*VHE(L)*HVI(L)) + TUTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + TVTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEAV=CUE(L)*UTMPA+CVE(L)*VTMPA + VELNAV=CUN(L)*UTMPA+CVN(L)*VTMPA +C +C WRITE VELVECH.OUT +C + IF(KC.GT.1)WRITE(10,200)IL(L),JL(L),DLON(L), + & DLAT(L),VELEKC,VELNKC,VELEKB,VELNKB,VELEAV,VELNAV + IF(KC.EQ.1)WRITE(10,200)IL(L),JL(L),DLON(L),DLAT(L), + & VELEKB,VELNKB +C +C WRITE VELVECH.COC +C + IF(KC.GT.1)WRITE(20,'(2I5,1X,10E14.6)')IL(L),JL(L),DLON(L), + & DLAT(L),UTMPS,VTMPS,UTMPB,VTMPB,UTMPA,VTMPA,TUTMP,TVTMP + IF(KC.EQ.1)WRITE(20,200)IL(L),JL(L),DLON(L),DLAT(L), + & UTMPS,VTMPS,TUTMP,TVTMP + UTMP=5000.*STCUV(L)*(RSSBCE(L)*TBX(L+1)+RSSBCW(L)*TBX(L)) + VTMP=5000.*STCUV(L)*(RSSBCN(L)*TBY(LN )+RSSBCS(L)*TBY(L)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + TMPV1=10000.*TAUB(L) + TMPV2=10000.*TAUBSED(L) + TMPV3=10000.*TAUBSND(L) +C +C WRITE TAUVECH.OUT +C + WRITE(11,200)IL(L),JL(L),DLON(L),DLAT(L),VELEKC, + & VELNKC,TMPV1,TMPV2,TMPV3 + IF(ISTRAN(7).GE.1) THEN + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,1) + & +RSSBCW(L)*QSBDLDX(L ,1)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,1) + & +RSSBCS(L)*QSBDLDY(L ,1)) + VELEKC=CUE(L)*UTMP+CVE(L)*VTMP + VELNKC=CUN(L)*UTMP+CVN(L)*VTMP + UTMP=0.0005*STCUV(L)*(RSSBCE(L)*QSBDLDX(L+1,2) + & +RSSBCW(L)*QSBDLDX(L,2)) + VTMP=0.0005*STCUV(L)*(RSSBCN(L)*QSBDLDY(LN ,2) + & +RSSBCS(L)*QSBDLDY(L,2)) + VELEKB=CUE(L)*UTMP+CVE(L)*VTMP + VELNKB=CUN(L)*UTMP+CVN(L)*VTMP + WRITE(12,200)IL(L),JL(L),DLON(L),DLAT(L),VELEKC,VELNKC, + & VELEKB,VELNKB + END IF + IF(ISWAVE.EQ.2)THEN + ZBREFF=100.*ZBRE(L) + WRITE(14,200)IL(L),JL(L),DLON(L),DLAT(L),ZBREFF + QTURBC=QBOTTMP*QQSQR(L,0) + WRITE(15,200)IL(L),JL(L),DLON(L),DLAT(L),QTURBC + QTURBC=QBOTTMP*QQWV2(L) + WRITE(16,200)IL(L),JL(L),DLON(L),DLAT(L),QTURBC + ENDIF + ENDDO + ENDIF +!ykchoi] + CLOSE(10) + CLOSE(11) + IF(ISTRAN(7).GT.0)CLOSE(12) + CLOSE(13) + CLOSE(14) + CLOSE(15) + CLOSE(16) + CLOSE(20) + ENDIF +C +C *** EE BEGIN BLOCK +C *** OUTPUT EFDC EXPLORER FORMAT. DO NOT CHANGE OUTPUTS! +C *** MUST EXACTLY MATCH EFDC_EXPLORER INP +C + IF(IVPHXY.EQ.3)THEN + IF(JSVPH.EQ.1)THEN + LINES=LA-1 + OPEN(10,FILE='EE_VEL.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=103 + WRITE(10)VER,IC,JC,KC,LINES + WRITE(10)RSSBCE,RSSBCW,RSSBCS,RSSBCN + + CLOSE(10) + JSVPH=0 + ENDIF + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + ELSE + TIME=TIMESEC + ENDIF + TIME=TIME/86400. + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + ENDIF + + OPEN(10,FILE='EE_VEL.OUT',POSITION='APPEND',STATUS='OLD', + & FORM='UNFORMATTED') + WRITE (10)N,TIME,DELT + + ! *** Write the UVW Instantaneous Velocity Field (Unrotated) + IF(IBIN_TYPE.EQ.1)THEN + DO L=2,LA + WRITE(10)(U(L,K),V(L,K),W(L,K),K=1,KC) + ENDDO + ENDIF + IF(IBIN_TYPE.EQ.0)THEN + WRITE(10)U + WRITE(10)V + WRITE(10)W + ENDIF + CALL FLUSH(10) + CLOSE(10) + ENDIF + ENDIF +C +C *** EE END BLOCK +C + 99 FORMAT(A80) + 100 FORMAT(I10,F12.4) + 101 FORMAT(2I10) + 200 FORMAT(2I5,1X,8E14.6) + 201 FORMAT(8E14.6) + 250 FORMAT(12E12.4) + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for new file mode 100644 index 000000000..0d99b065f --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for @@ -0,0 +1,635 @@ + SUBROUTINE WQ3D_mpi(ISTL_,IS2TL_) +C +C CONTROL SUBROUTINE FOR WATER QUALITY MODEL +C ORGINALLY CODED BY K.-Y. PARK +C OPTIMIZED AND MODIFIED BY J. M. HAMRICK +C CHANGE RECORD +C +C Merged SNL and DS-INTL + USE GLOBAL + USE MPI + + REAL TTMP,T1TMP + REAL, SAVE :: DAYNEXT + REAL, SAVE :: SUNDAY1, SUNDAY2, SUNSOL1, SUNSOL2 + REAL, SAVE :: SUNFRC1, SUNFRC2 +!{ GeoSR, YSSONG. 2012/12/15, RESTART + REAL, SAVE :: SUNFRC0, SUNSOL0, SUNFRC11, SUNSOL11 + REAL, SAVE :: SUNFRC01,SUNSOL02,WQI0OPT0 + REAL, SAVE :: SUNFRC22,SUNSOL22,SUNFRC33, SUNSOL33 + INTEGER ISUNDAY2,IDAYNEXT +!} GeoSR + INTEGER*4, SAVE :: M + + DATA IWQTICI,IWQTAGR,IWQTSTL,IWQTSUN,IWQTBEN,IWQTPSL,IWQTNPL/7*0/ + DATA ISMTICI/0/ + + REAL SUNSOL01,SUNFRC02 + SUNSOL01=0.0 + SUNFRC02=0.0 + + + S1TIME=MPI_TIC() + IF(ETIMEDAY.LE.(DTWQ+1.E-8))THEN + DAYNEXT=FLOAT(INT(TIMEDAY))+1. +!{ GeoSR, YSSONG. 2012/12/15, RESTART + ISUNDAY2=0 + IDAYNEXT=0 + !IF(MYRANK.EQ.0.AND.DEBUG) OPEN(1234,FILE='SOL.DAT') + IF(MYRANK.EQ.0) OPEN(1234,FILE='SOL.DAT') +!} GeoSR + ENDIF + ! *** PMC - NEW IMPLEMENTATION TO USE DAILY (FROM HOURLY) SOLAR RADIATION FOR ALGAL GROWTH + IF(ITNWQ.EQ.0.AND.IWQSUN.GT.1.AND.NASER.GT.0)THEN + ! *** BUILD THE DAILY AVERAGE SOLAR RADIATION FROM THE ASER DATA +!{ GeoSR, YSSONG. 2012/12/15, RESTART + ! SUNDAY1 = TIMEDAY+0.5 + SUNDAY1 = FLOAT(INT(TIMEDAY))-0.5 +! SUNDAY2 = DAYNEXT+0.5 + SUNDAY2 = DAYNEXT-0.5 + + ! *** FIND 1ST POINT + M = 1 +! DO WHILE (TASER(M,1).LT.SUNDAY1-0.5) + DO WHILE (TASER(M,1).LT.SUNDAY2-0.5) + M = M+1 + END DO +!} GeoSR + + ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION + M1 = 0 + M2 = 0 + SUNSOL1 = 0.0 + DO WHILE (TASER(M,1).LT.SUNDAY2+0.5) + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL1=SUNSOL1+SOLSWR(M,1) + ENDIF + M = M+1 + END DO + IF(M1.GT.0)THEN + SUNFRC1=FLOAT(M2)/FLOAT(M1) + SUNSOL1=SUNSOL1/FLOAT(M1) + ELSE + SUNFRC1=1.0 + ENDIF + + ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION + M1 = 0 + M2 = 0 + SUNSOL2 = 0. + DO WHILE (TASER(M,1).LT.SUNDAY2+1.5) + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL2=SUNSOL2+SOLSWR(M,1) + ENDIF + M = M+1 + END DO + IF(M1.GT.0)THEN + SUNFRC2=FLOAT(M2)/FLOAT(M1) + SUNSOL2=SUNSOL2/FLOAT(M1) + ELSE + SUNFRC2=1. + ENDIF + ENDIF +!{ GeoSR, YSSONG. 2012/12/15, RESTART + IF(ITNWQ.EQ.0)THEN +! IF(ISUNDAY2.EQ.0)THEN + IF(IWQSUN.GT.1.AND.NASER.GT.0)THEN + DO NDUM=2,4 + M = 1 + DO WHILE (TASER(M,1).LT.DAYNEXT-(FLOAT(NDUM))) + M = M+1 + END DO + M1 = 0 + M2 = 0 + SUNSOL0 = 0. +! DO WHILE (TASER(M,1).LT.SUNDAY2-0.5) + DO WHILE (TASER(M,1).LT.DAYNEXT-(FLOAT(NDUM))+1.0) + IF(TASER(M,1).GE.DAYNEXT-(FLOAT(NDUM)))THEN + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL0=SUNSOL0+SOLSWR(M,1) !!! 1 day average + ENDIF + M = M+1 + ENDIF + END DO + IF(M1.GT.0)THEN + SUNFRC0=FLOAT(M2)/FLOAT(M1) + SUNSOL0=SUNSOL0/FLOAT(M1) !!! avg SUNSOL for timeday + ELSE + SUNFRC0=1.0 + ENDIF + IF(NDUM.EQ.2)THEN ! PREVIOUS DAY + SUNSOL11=SUNSOL0 + SUNFRC11=SUNFRC0 + ELSEIF(NDUM.EQ.3)THEN ! TWO DAYS AGO + SUNSOL22=SUNSOL0 + SUNFRC22=SUNFRC0 + ELSEIF(NDUM.EQ.4)THEN ! THREE DAYS AGO + SUNSOL33=SUNSOL0 + SUNFRC33=SUNFRC0 + ENDIF + END DO + ENDIF +! ENDIF + +! IF(IDAYNEXT.EQ.0)THEN + IF(IWQSUN.GT.1.AND.NASER.GT.0)THEN + DO NDUM=2,4 + IF(NDUM.EQ.2)THEN ! PREVIOUS DAY + SUNSOL01=SUNSOL11 + SUNFRC01=SUNFRC11 + SUNSOL02=SUNSOL1 + SUNFRC02=SUNFRC1 + ELSEIF(NDUM.EQ.3)THEN ! TWO DAYS AGO + SUNSOL01=SUNSOL22 + SUNFRC01=SUNFRC22 + SUNSOL02=SUNSOL11 + SUNFRC02=SUNFRC11 + ELSEIF(NDUM.EQ.4)THEN ! THREE DAYS AGO + SUNSOL01=SUNSOL33 + SUNFRC01=SUNFRC33 + SUNSOL02=SUNSOL22 + SUNFRC02=SUNFRC22 + ENDIF + IF(IWQSUN.GT.1)THEN + RATIO = (TIMEDAY-SUNDAY1) + SOLARAVG = RATIO*(SUNSOL02-SUNSOL01)+SUNSOL01 + WQFD=RATIO*(SUNFRC02-SUNFRC01)+SUNFRC01 + ! *** SOLAR RADIATION IN LANGLEYS/DAY + WQI0 = PARADJ*2.065*SOLARAVG + IF(IWQSUN.EQ.2)THEN + ! *** OPTIMAL SOLAR RADIATION IS ALWAYS UPDATED BASED ON DAY AVERAGED + WQI0OPT0 = MAX(WQI0OPT0, WQI0/(WQFD+1.E-18)*0.85) + IF(NASER.GT.1.OR.USESHADE)THEN + SOLARAVG_R8=0. +c SOLARAVG=0. + DO L=LMPI2,LMPILA + SOLARAVG_R8=SOLARAVG_R8+SOLSWRT(L) +c SOLARAVG=SOLARAVG+SOLSWRT(L) + ENDDO + CALL MPI_ALLREDUCE(SOLARAVG_R8,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) +c CALL MPI_ALLREDUCE(SOLARAVG,MPI_R4,1,MPI_REAL, +c & MPI_SUM,MPI_COMM_WORLD,IERR) + SOLARAVG=REAL(MPI_R8) +c SOLARAVG=REAL(MPI_R4) + SOLARAVG=SOLARAVG/FLOAT(LA-1) + ELSE + ! *** Spatially Constant Atmospheric Parameters + !SOLARAVG=SOLSWRT(2) + SOLARAVG=SOLSWRTT(1) + ENDIF + ! *** SOLAR RADIATION IN LANGLEYS/DAY + WQI0 = PARADJ*2.065*SOLARAVG + WQFD=1. + ELSEIF(IWQSUN.GT.2)THEN + ! *** OPTIMAL SOLAR RADIATION IS ALWAYS UPDATED BASED ON DAY AVERAGED + WQI0OPT0 = MAX(WQI0OPT0, WQI0) + ENDIF + IF(NDUM.EQ.2)THEN ! PREVIOUS DAY + WQI1=WQI0OPT0 + ELSEIF(NDUM.EQ.3)THEN ! TWO DAYS AGO + WQI2=WQI0OPT0 + ELSEIF(NDUM.EQ.4)THEN ! THREE DAYS AGO + WQI3=WQI0OPT0 + ENDIF + IF(IWQSUN.GT.0) WQI0OPT0 = 0.0 + ENDIF + END DO + ENDIF +! ENDIF + ENDIF +!} GeoSR, 2012/12/15 + MPI_WTIMES(701)=MPI_WTIMES(701)+MPI_TOC(S1TIME) +C +C ** READ INITIAL CONDITIONS +C + S1TIME=MPI_TIC() + IF(IWQICI.EQ.1) CALL RWQICI + MPI_WTIMES(702)=MPI_WTIMES(702)+MPI_TOC(S1TIME) +!{ GEOSR : DAY read jgcho 2016.10.06 + IF(ISDYNSTP.EQ.0)THEN + TIMTMP=(DT*FLOAT(N)+TCON*TBEGIN)/86400. + ELSE + TIMTMP=TIMESEC/86400. + ENDIF +!} GEOSR : DAY read jgcho 2016.10.06 +C +C ** READ TIME/SPACE VARYING ALGAE PARAMETERS +C +!{ GEOSR : DAY read jgcho 2016.10.06 +! IF(IWQAGR.EQ.1 .AND. ITNWQ.EQ.IWQTAGR) CALL RWQAGR(IWQTAGR) + S1TIME=MPI_TIC() + IF(IWQAGR.EQ.1) THEN + IF(TIMTMP .GE. AGRDAY) CALL RWQAGR(TIMTMP) + ENDIF + MPI_WTIMES(703)=MPI_WTIMES(703)+MPI_TOC(S1TIME) +!} GEOSR : DAY read jgcho 2016.10.06 +C +C +C ** READ TIME/SPACE VARYING SETTLING VELOCITIES +C +!{ GEOSR : DAY read jgcho 2016.10.06 +! IF(IWQSTL.EQ.1 .AND. ITNWQ.EQ.IWQTSTL) CALL RWQSTL(IWQTSTL) + S1TIME=MPI_TIC() + IF(IWQSTL.EQ.1) THEN + IF(TIMTMP .GE. STLDAY) CALL RWQSTL(TIMTMP) + ENDIF + MPI_WTIMES(704)=MPI_WTIMES(704)+MPI_TOC(S1TIME) +!{ GEOSR : DAY read jgcho 2016.10.06 +C +C *** READ BENTHIC FLUX IF REQUIRED +C *** CALL SPATIALLY AND TIME VARYING BENTHIC FLUX HERE. ONLY CALL RWQBEN2 +C *** IF SIMULATION TIME IS >= THE NEXT TIME IN THE BENTHIC FILE. +C + S1TIME=MPI_TIC() + IF(IWQBEN .EQ. 2)THEN +! IF(ISDYNSTP.EQ.0)THEN +! TIMTMP=(DT*FLOAT(N)+TCON*TBEGIN)/86400. +! ELSE +! TIMTMP=TIMESEC/86400. +! ENDIF + IF(TIMTMP .GE. BENDAY)THEN + CALL RWQBEN2(TIMTMP) + ENDIF + ENDIF + MPI_WTIMES(705)=MPI_WTIMES(705)+MPI_TOC(S1TIME) +C +C ** UPDATE POINT SOURCE LOADINGS +C + S1TIME=MPI_TIC() + IF(IWQPSL.EQ.1)THEN + CALL RWQPSL + ELSEIF(IWQPSL.EQ.2) THEN + CALL CALCSER_mpi(ISTL_) + ENDIF + MPI_WTIMES(706)=MPI_WTIMES(706)+MPI_TOC(S1TIME) +C + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'fWQV = ', sum(abs(dble(WQV))),WQI0,PARADJ,SOLARAVG + ENDIF + ENDIF + + S1TIME=MPI_TIC() + IF(MYRANK.EQ.0) CALL RWQATM_mpi + MPI_WTIMES(707)=MPI_WTIMES(707)+MPI_TOC(S1TIME) +C +C ** READ SEDIMENT MODEL INITIAL CONDITION +C + S1TIME=MPI_TIC() + IF(IWQBEN.EQ.1)THEN + IF(ISMICI.EQ.1 .AND. ITNWQ.EQ.ISMTICI) CALL RSMICI(ISMTICI) + ENDIF + MPI_WTIMES(708)=MPI_WTIMES(708)+MPI_TOC(S1TIME) +C +C ** UPDATE OLD CONCENTRATIONS +C FOLLOWING THE CALL TO CALWQC MINUS OLD D.O. BEFORE THE CALL). +C FIRST SUBTRACT THE OLD D.O. HERE: +C + S1TIME=MPI_TIC() + IF(ISMTSB.LT.ISMTSE)THEN + DO K=1,KC + DO L=LMPI2,LMPILA + XMRM = WQV(L,K,19)*DTWQ*DZC(K)*HP(L) + XDOTRN(L,K) = XDOTRN(L,K) - XMRM + XDOALL(L,K) = XDOALL(L,K) - XMRM + ENDDO + ENDDO + ENDIF + MPI_WTIMES(709)=MPI_WTIMES(709)+MPI_TOC(S1TIME) +C +C ** CALCULATE PHYSICAL TRANSPORT +C ** WQV(L,K,NW) SENT TO PHYSICAL TRANSPORT AND TRANSPORTED +C ** VALUE RETURNED IN WQV(L,K,NW) +C +C + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'gWQV = ', sum(abs(dble(WQV))),WQI0,PARADJ,SOLARAVG + ENDIF + ENDIF + + S1TIME=MPI_TIC() +C CALL CALWQC(ISTL_,IS2TL_) !transports (advects/disperses) WQV + CALL CALWQC_mpi(ISTL_,IS2TL_) !transports (advects/disperses) WQV + MPI_WTIMES(710)=MPI_WTIMES(710)+MPI_TOC(S1TIME) + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'hWQV = ', sum(abs(dble(WQV))),WQI0,PARADJ,SOLARAVG + ENDIF + ENDIF +C +C FOLLOWING THE CALL TO CALWQC MINUS OLD D.O. BEFORE THE CALL). +C NOW ADD THE NEW D.O. HERE: +C + S1TIME=MPI_TIC() + IF(ISMTSB.LT.ISMTSE)THEN + DO K=1,KC + DO L=LMPI2,LMPILA + XMRM = WQV(L,K,19)*DTWQ*DZC(K)*HP(L) + XDOTRN(L,K) = XDOTRN(L,K) + XMRM + XDOALL(L,K) = XDOALL(L,K) + XMRM + ENDDO + ENDDO + ENDIF + MPI_WTIMES(711)=MPI_WTIMES(711)+MPI_TOC(S1TIME) +C +C ** UPDATE WATER COLUMN KINETICS AND SEDIMENT MODEL +C ** OVER LONGER TIME INTERVALS THAN PHYSICAL TRANSPORT +C ** IF NWQKDPT .GT. 1 +C + NWQKCNT=NWQKCNT+1 + IF(ITNWQ.EQ.0.OR.NWQKCNT.EQ.NWQKDPT)THEN + S1TIME=MPI_TIC() + !IF(ITNWQ.NE.0)NWQKCNT=0 PMC + NWQKCNT=0 + ! ** UPDATE SOLAR RADIATION INTENSITY + ! WQI1 = SOLAR RADIATION ON PREVIOUS DAY + ! WQI2 = SOLAR RADIATION TWO DAYS AGO + ! WQI3 = SOLAR RADIATION THREE DAYS AGO + ! *** UPDATE OCCURS ONLY WHEN THE SIMULATION DAY CHANGES. + IF(TIMEDAY.GT.DAYNEXT)THEN ! *** DSLLC: FORCE A SOLAR DAY UPDATE +!{ GeoSR : 2012/12/15 SOLAR RADIATION FOR RESTART + IDAYNEXT=1 +!} GeoSR : 2012/12/15 + WQI3 = WQI2 + WQI2 = WQI1 + WQI1 = WQI0OPT + IF(IWQSUN.GT.0)WQI0OPT = 0.0 + DAYNEXT=DAYNEXT+1. + ENDIF + + IF(IWQSUN.GT.1)THEN + IF(TIMEDAY.GT.SUNDAY2)THEN +!{ GeoSR : 2012/12/15 SOLAR RADIATION FOR RESTART + ISUNDAY2=1 +!} GeoSR : 2012/12/15 + ! *** BUILD THE DAILY AVERAGE SOLAR RADIATION FROM THE ASER DATA + SUNDAY1 = SUNDAY2 + SUNSOL1 = SUNSOL2 + SUNFRC1 = SUNFRC2 + + ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION + M1 = 0 + M2 = 0 + SUNSOL2 = 0. + SUNDAY2 = SUNDAY2+1. + DO WHILE (TASER(M,1).LT.SUNDAY2+0.5) + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL2=SUNSOL2+SOLSWR(M,1) + ENDIF + M = M+1 + END DO + IF(M1.GT.0)THEN + SUNFRC2=FLOAT(M2)/FLOAT(M1) + SUNSOL2=SUNSOL2/FLOAT(M1) + ELSE + SUNFRC2=1. + ENDIF + + ENDIF + ENDIF + MPI_WTIMES(712)=MPI_WTIMES(712)+MPI_TOC(S1TIME) + ! ** READ SOLAR RADIATION INTENSITY AND DAYLIGHT LENGTH + ! NOTE: IWQSUN=1 CALLS SUBROUTINE RWQSUN WHICH READS THE DAILY + ! SOLAR RADIATION DATA FROM FILE SUNDAY.INP WHICH + ! ARE IN UNITS OF LANGLEYS/DAY. + ! IWQSUN=2 USES THE HOURLY SOLAR RADIATION DATA FROM ASER.INP + ! COUPLED WITH THE COMPUTED OPTIMAL DAILY LIGHT TO + ! LIMIT ALGAL GROWTH. + ! IWQSUN=3 USES THE DAILY AVERAGE SOLAR RADIATION DATA COMPUTED + ! FROM THE HOURLY ASER.INP AND THE COMPUTED OPTIMAL DAILY + ! LIGHT TO LIMIT ALGAL GROWTH. + ! IWQSUN>1 USES THE DAILY AVERAGE SOLAR RADIATION DATA COMPUTED + ! FROM THE HOURLY ASER.INP DATA. CONVERTS WATTS/M**2 TO + ! LANGLEYS/DAY USING 2.065. COMPUTES THE FRACTION OF + ! DAYLIGHT AND ADJUSTS FOR PHOTOSYNTHETIC ACTIVE RADIATION BY + ! PARADJ (~0.43) + ! + S1TIME=MPI_TIC() + IF(IWQSUN.EQ.0)THEN + WQI0OPT = WQI0 + ELSEIF(IWQSUN.EQ.1)THEN + CALL RWQSUN + WQI0=SOLSRDT + WQFD=SOLFRDT + ! *** OPTIMAL SOLAR RADIATION IS ALWAYS UPDATED BASED ON DAY AVERAGED + WQI0OPT = MAX(WQI0OPT, WQI0) + ELSEIF(IWQSUN.GT.1)THEN + RATIO = (TIMEDAY-SUNDAY1) + SOLARAVG = RATIO*(SUNSOL2-SUNSOL1)+SUNSOL1 + WQFD=RATIO*(SUNFRC2-SUNFRC1)+SUNFRC1 + + ! *** SOLAR RADIATION IN LANGLEYS/DAY + WQI0 = PARADJ*2.065*SOLARAVG + + IF(IWQSUN.EQ.2)THEN + ! *** OPTIMAL SOLAR RADIATION IS ALWAYS UPDATED BASED ON DAY AVERAGED + WQI0OPT = MAX(WQI0OPT, WQI0/(WQFD+1.E-18)*0.85) + + IF(NASER.GT.1.OR.USESHADE)THEN + SOLARAVG_R8=0. +c SOLARAVG=0. + DO L=LMPI2,LMPILA + SOLARAVG_R8=SOLARAVG_R8+SOLSWRT(L) +c SOLARAVG=SOLARAVG+SOLSWRT(L) + ENDDO + CALL MPI_ALLREDUCE(SOLARAVG_R8,MPI_R8,1,MPI_DOUBLE, + & MPI_SUM,MPI_COMM_WORLD,IERR) +c CALL MPI_ALLREDUCE(SOLARAVG,MPI_R4,1,MPI_REAL, +c & MPI_SUM,MPI_COMM_WORLD,IERR) + SOLARAVG=REAL(MPI_R8) +c SOLARAVG=REAL(MPI_R4) + SOLARAVG=SOLARAVG/FLOAT(LA-1) + ELSE + ! *** Spatially Constant Atmospheric Parameters + SOLARAVG=SOLSWRT(2) + !SOLARAVG=SOLSWRTT(1) + ENDIF + ! *** SOLAR RADIATION IN LANGLEYS/DAY + WQI0 = PARADJ*2.065*SOLARAVG + WQFD=1. + ELSE + ! *** OPTIMAL SOLAR RADIATION IS ALWAYS UPDATED BASED ON DAY AVERAGED + WQI0OPT = MAX(WQI0OPT, WQI0) + ENDIF + ENDIF + MPI_WTIMES(713)=MPI_WTIMES(713)+MPI_TOC(S1TIME) + IF(.FALSE.)THEN + call collect_in_zero(SOLSWRT) + IF(MYRANK.EQ.0)THEN + PRINT*, n,'SOLARAVG = ', WQI0,sum(SOLSWRT),SOLARAVG + ENDIF + ENDIF +C +C ** LOAD WQV INTO WQVO FOR REACTION CALCULATION +C + S1TIME=MPI_TIC() + NMALG=0 + IF(IDNOTRVA.GT.0) NMALG=1 + DO NW=1,NWQV+NMALG + IF(ISTRWQ(NW).NE.0)THEN + DO K=1,KC + DO L=LMPI2,LMPILA + WQVO(L,K,NW)=WQV(L,K,NW) + ENDDO + ENDDO + ENDIF + ENDDO +!{ GEOSR X-species : jgcho 2015.09.30 + DO NW=1,NXSP + DO K=1,KC + DO L=LMPI2,LMPILA + WQVOX(L,K,NW)=WQVX(L,K,NW) + ENDDO + ENDDO + ENDDO + MPI_WTIMES(714)=MPI_WTIMES(714)+MPI_TOC(S1TIME) +!} GEOSR X-species : jgcho 2015.09.30 +C +C ** CALCULATE KINETIC SOURCES AND SINKS +C + S1TIME=MPI_TIC() +![ GeoSR : 2012/12/15 + !IF(MYRANK.EQ.0.AND.DEBUG) + IF(MYRANK.EQ.0) + & WRITE(1234,*) TIMEDAY,DAYNEXT,WQI1,WQI2,WQI3 +! GeoSR : 2012/12/15] + CALL CPU_TIME(TTMP) + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=0,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'11WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'11WQVX = ', sum(abs(dble(WQVX))) + PRINT*, 'WQFDI0A =',WQI0BOT(3184),WQI0 + ENDIF + ENDIF + S1TIME=MPI_TIC() + IF(ISWQLVL.EQ.0) CALL WQSKE0 + IF(ISWQLVL.EQ.1) CALL WQSKE1 + IF(ISWQLVL.EQ.2) CALL WQSKE2 + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=0,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'12WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'12WQVX = ', sum(abs(dble(WQVX))) + PRINT*, 'WQFDI0B =',WQI0BOT(3184),WQI0 + ENDIF + ENDIF + IF(ISWQLVL.EQ.3) CALL WQSKE3_mpi + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=0,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'13WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'13WQVX = ', sum(abs(dble(WQVX))) + ENDIF + ENDIF + IF(ISWQLVL.EQ.4) CALL WQSKE4 + CALL CPU_TIME(T1TMP) + TWQKIN=TWQKIN+T1TMP-TTMP + MPI_WTIMES(715)=MPI_WTIMES(715)+MPI_TOC(S1TIME) + IF(.FALSE.)THEN + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=0,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + IF(MYRANK.EQ.0)THEN + PRINT*, n,'14WQV = ', sum(abs(dble(WQV))) + PRINT*, n,'14WQVX = ', sum(abs(dble(WQVX))) + ENDIF + ENDIF +C +C ** DIAGNOSE NEGATIVE CONCENTRATIONS +C + S1TIME=MPI_TIC() + IF(IWQNC.EQ.1)CALL WWQNC + MPI_WTIMES(716)=MPI_WTIMES(716)+MPI_TOC(S1TIME) +C +C ** WRITE TIME SERIES +C + IF(ITNWQ.GE.IWQTSB .AND. ITNWQ.LE.IWQTSE.AND.IWQTSE.GT.0)THEN + S1TIME=MPI_TIC() + IF(MOD(ITNWQ,IWQTSDT).EQ.0) CALL WWQTS +C +C CALL WWQTSBIN !{GeoSR, 2014.10.13 JHLEE, GROWTH LIMIT PRINT +C + ENDIF + MPI_WTIMES(717)=MPI_WTIMES(717)+MPI_TOC(S1TIME) + S1TIME=MPI_TIC() + IF(MYRANK.EQ.0) CALL WWQTSBIN !{GeoSR, 2014.10.13 JHLEE, GROWTH LIMIT PRINT + MPI_WTIMES(718)=MPI_WTIMES(718)+MPI_TOC(S1TIME) +C +C ** CALL SEDIMENT DIAGENSIS MODEL +C + S1TIME=MPI_TIC() + IF(IWQBEN.EQ.1)THEN + CALL CPU_TIME(TTMP) + CALL SMMBE + CALL CPU_TIME(T1TMP) + TWQSED=TWQSED+T1TMP-TTMP + IF(ISMTS.GE.1)THEN +C +C ** WRITE SEDIMENT MODEL TIME SERIES +C + IF(ITNWQ.GE.ISMTSB .AND. ITNWQ.LE.ISMTSE)THEN + IF(MOD(ITNWQ,ISMTSDT).EQ.0) CALL WSMTS + ENDIF + ENDIF +C +C ** WRITE SEDIMENT MODEL FLUXES TO BINARY FILE: +C + IF(ITNWQ.GE.ISMTSB .AND. ITNWQ.LE.ISMTSE)THEN + CALL WSMTSBIN + ENDIF + ENDIF + MPI_WTIMES(719)=MPI_WTIMES(719)+MPI_TOC(S1TIME) + ENDIF +C +C ** UPDATE TIME IN DAYS +C +![ GeoSR : 2010/07/27 +c ITNWQ = ITNWQ + 2 + ITNWQ = ITNWQ + 1 +! GeoSR : 2010/07/27] +C +C ** ENDIF ON KINETIC AND SEDIMENT UPDATE +C ** INSERT TIME CALL +C ** WRITE RESTART FILES +C + RETURN + END + diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3_mpi.for new file mode 100644 index 000000000..f882467fc --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3_mpi.for @@ -0,0 +1,2611 @@ + SUBROUTINE WQSKE3_mpi +C +C: AFTER COMPUTING NEW VALUES, STORE WQVO+WQV INTO WQVO(L,K,NWQV) EXCEPT +C: NWQV=15,19,21. +C ORGINALLY CODED BY K.-Y. PARK +C OPTIMIZED AND MODIFIED BY J.M. HAMRICK +C +C PMC - THIS IS THE SAME AS WQSKE2 +C +C LAST MODIFIED BY YSSONG ON 24 NOVEMBER 2011 + + USE GLOBAL + USE MPI +!{GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 + CHARACTER*11 FLN + CHARACTER*80 FMTSTR +!} +C + REAL WQGNX(NXSP),WQGPX(NXSP),WQF1NX(NXSP) ! GEOSR X-species : jgcho 2015.09.24 + REAL WQISX(NXSP),WQFDX(NXSP),WQF2IX(NXSP) ! GEOSR X-species : jgcho 2015.09.25 + REAL WQTTX(NXSP) ! GEOSR X-species : jgcho 2015.09.25 + REAL WQACX(NXSP),WQKKX(LCMWQ,NXSP) !,WQRCX(NXSP) GEOSR X-species : jgcho 2015.10.01 + REAL WQA2X(NXSP),WQA3X(NXSP) ! GEOSR X-species : jgcho 2015.10.10 + !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + REAL WQFDGSC(2),WQFDGSCX + !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + INTEGER LWQ3K + REAL WQVREA,WQTT1,WQTTT,WQF1NM,WQAVGIO,WQTTB,WQA1C + WQVREA=0.0 + WQTTT=0.0 + WQF1NM=0.0 + WQAVGIO=0.0 + WQTTB=0.0 + WQA1C=0.0 + WQTT1=0.0 + + CNS1=2.718 + NS=1 + IF(.FALSE.)THEN + IF(MYRANK.EQ.0) THEN + PRINT*, 'WQFDIA1 =',WQI0BOT(3184),WQI0 + ENDIF + ENDIF +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQI0BOT(L)=WQI0 + ENDDO + IF(.FALSE.)THEN + IF(MYRANK.EQ.0) THEN + PRINT*, 'WQFDIA2 =',WQI0BOT(3184),WQI0 + ENDIF + ENDIF + +!{ GEOSR STOKES : YSSONG 2015.08.18 + CYANOMASS=0.0 +!} GEOSR STOKES : YSSONG 2015.08.18 + +!{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 + IF(IWQBEN.EQ.0.AND.IWQBENOX.EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQBFCOD(L)=WQBFOXCOD(1,1) + WQBFNH4(L)=WQBFOXNH4(1,1) + WQBFNO3(L)=WQBFOXNO3(1,1) + WQBFO2(L)= WQBFOXO2(1,1) + WQBFPO4D(L)=WQBFOXPO4D(1,1) + WQBFSAD(L)=WQBFOXSAD(1,1) + ENDDO + ELSEIF(IWQBEN.EQ.0.AND.IWQBENOX.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(WQVO(L,1,19).GT.DOXCRT)THEN + WQBFCOD(L)=WQBFOXCOD(1,1) + WQBFNH4(L)=WQBFOXNH4(1,1) + WQBFNO3(L)=WQBFOXNO3(1,1) + WQBFO2(L)= WQBFOXO2(1,1) + WQBFPO4D(L)=WQBFOXPO4D(1,1) + WQBFSAD(L)=WQBFOXSAD(1,1) + ELSE + WQBFCOD(L)=WQBFOXCOD(1,2) + WQBFNH4(L)=WQBFOXNH4(1,2) + WQBFNO3(L)=WQBFOXNO3(1,2) + WQBFO2(L)= WQBFOXO2(1,2) + WQBFPO4D(L)=WQBFOXPO4D(1,2) + WQBFSAD(L)=WQBFOXSAD(1,2) + ENDIF + ENDDO + ENDIF + + IF(IWQBEN.EQ.2.AND.IWQBENOX.EQ.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQBFCOD(L)=WQBFOXCOD(L,1) + WQBFNH4(L)=WQBFOXNH4(L,1) + WQBFNO3(L)=WQBFOXNO3(L,1) + WQBFO2(L)= WQBFOXO2(L,1) + WQBFPO4D(L)=WQBFOXPO4D(L,1) + WQBFSAD(L)=WQBFOXSAD(L,1) + ENDDO + ELSEIF(IWQBEN.EQ.2.AND.IWQBENOX.NE.0)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IF(WQVO(L,1,19).GT.DOXCRT)THEN + WQBFCOD(L)=WQBFOXCOD(L,1) + WQBFNH4(L)=WQBFOXNH4(L,1) + WQBFNO3(L)=WQBFOXNO3(L,1) + WQBFO2(L)= WQBFOXO2(L,1) + WQBFPO4D(L)=WQBFOXPO4D(L,1) + WQBFSAD(L)=WQBFOXSAD(L,1) + ELSE + WQBFCOD(L)=WQBFOXCOD(L,2) + WQBFNH4(L)=WQBFOXNH4(L,2) + WQBFNO3(L)=WQBFOXNO3(L,2) + WQBFO2(L)= WQBFOXO2(L,2) + WQBFPO4D(L)=WQBFOXPO4D(L,2) + WQBFSAD(L)=WQBFOXSAD(L,2) + ENDIF + ENDDO + ENDIF +!} GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 + IF(.FALSE.)THEN + DO NSP=1,21; call collect_in_zero_array(WQV(:,:,NSP)); ENDDO !#1-1 + IF(MYRANK.EQ.0) THEN + DO LWQ3K=1,21 + PRINT*,'WQ1V=',LWQ3K,sum(abs(dble(WQV(:,:,LWQ3K)))) + ENDDO + PRINT*, 'WQFDIA =',WQI0BOT(3184) + ENDIF + ENDIF + + DO K=KC,1,-1 +C +C DZWQ=1/H, VOLWQ=1/VOL +C +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + TWQ(L)=TEM(L,K) + SWQ(L)=MAX(SAL(L,K), 0.0) + DZWQ(L) = 1.0 / (DZC(K)*HP(L)) + VOLWQ(L) = DZWQ(L) / DXYP(L) + IMWQZT(L)=IWQZMAP(L,K) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQBCSET(L,1) = WQWSC(IMWQZT(L))*DZWQ(L) + WQBDSET(L,1) = WQWSD(IMWQZT(L))*DZWQ(L) + WQBGSET(L,1) = WQWSG(IMWQZT(L))*DZWQ(L) + WQRPSET(L,1) = WQWSRP(IMWQZT(L))*DZWQ(L) + WQLPSET(L,1) = WQWSLP(IMWQZT(L))*DZWQ(L) +!{ GEOSR X-species : jgcho 2015.09.18 + DO nsp=1,NXSP + WQBXSET(L,1,nsp) = WQWSX(IMWQZT(L),nsp)*DZWQ(L) + ENDDO +!} GEOSR X-species : jgcho 2015.09.18 + ENDDO + IF(IWQSRP.EQ.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQWSSET(L,1) = WQWSS(IMWQZT(L))*DZWQ(L) + ENDDO + ENDIF + IF(K.NE.KC)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + IMWQZT1(L)=IWQZMAP(L,K+1) + ENDDO +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQBCSET(L,2) = WQWSC(IMWQZT1(L))*DZWQ(L) + WQBDSET(L,2) = WQWSD(IMWQZT1(L))*DZWQ(L) + WQBGSET(L,2) = WQWSG(IMWQZT1(L))*DZWQ(L) + WQRPSET(L,2) = WQWSRP(IMWQZT1(L))*DZWQ(L) + WQLPSET(L,2) = WQWSLP(IMWQZT1(L))*DZWQ(L) +!{ GEOSR X-species : jgcho 2015.09.18 + DO nsp=1,NXSP + WQBXSET(L,2,nsp) = WQWSX(IMWQZT1(L),nsp)*DZWQ(L) + ENDDO +!} GEOSR X-species : jgcho 2015.09.18 + ENDDO + IF(IWQSRP.EQ.1)THEN +!$OMP PARALLEL DO + DO L=LMPI2,LMPILA + WQWSSET(L,2) = WQWSS(IMWQZT1(L))*DZWQ(L) + ENDDO + ENDIF + ENDIF +C +C FIND AN INDEX FOR LOOK-UP TABLE FOR TEMPERATURE DEPENDENCY +C +!$OMP PARALLEL DO PRIVATE(TIMTMP) + DO L=LMPI2,LMPILA +C IWQT(L) = 2.0*TWQ(L) +11 +C - charles IWQT(L) = 10.0*TWQ(L) +151 +C IWQT(L) = NINT( 4.*TWQ(L)+121.) + IWQT(L)=NINT((TWQ(L)-WQTDMIN)/WQTDINC) ! *** DSLLC SINGLE LINE + IF(IWQT(L).LT.1 .OR. IWQT(L).GT.NWQTD)THEN + IF(ISDYNSTP.EQ.0)THEN + TIMTMP=DT*FLOAT(N)+TCON*TBEGIN + TIMTMP=TIMTMP/86400. + ELSE + TIMTMP=TIMESEC/86400. + ENDIF + IWQT(L)=MAX(IWQT(L),1) + IWQT(L)=MIN(IWQT(L),NWQTD) +C STOP 'ERROR!! INVALID WATER TEMPERATURE' + ENDIF + ENDDO +C 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) +C 911 FORMAT(/,'ERROR: TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) +C +C NOTE: MRM 04/29/99 ADDED ARRAYS TO KEEP TRACK OF +C NITROGEN, PHOSPHORUS, LIGHT, AND TEMPERATURE LIMITS +C FOR ALGAE GROWTH FOR CYANOBACTERIA, DIATOMS, GREENS, +C AND MACROALGAE. THESE ARE THE ARRAYS: +C XLIMNX(L,K) = NITROGEN LIMITATION FOR ALGAE GROUP X +C XLIMPX(L,K) = PHOSPHORUS LIMITATION FOR ALGAE GROUP X +C XLIMIX(L,K) = LIGHT LIMITATION FOR ALGAE GROUP X +C XLIMTX(L,K) = TEMPERATURE LIMITATION FOR ALGAE GROUP X +C BEGIN HORIZONTAL LOOP FOR ALGAE PARMETERS +C + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + RNH4WQ(L) = MAX (WQVO(L,K,14), 0.0) + RNO3WQ(L) = MAX (WQVO(L,K,15), 0.0) + PO4DWQ(L) = MAX (WQPO4D(L,K), 0.0) + RNH4NO3(L) = RNH4WQ(L) + RNO3WQ(L) + WQGNC = RNH4NO3(L) / (WQKHNC+RNH4NO3(L)+ 1.E-18) + WQGND = RNH4NO3(L) / (WQKHND+RNH4NO3(L)+ 1.E-18) + WQGNG = RNH4NO3(L) / (WQKHNG+RNH4NO3(L)+ 1.E-18) + WQGPC = PO4DWQ(L) / (WQKHPC+PO4DWQ(L)+ 1.E-18) + WQGPD = PO4DWQ(L) / (WQKHPD+PO4DWQ(L)+ 1.E-18) + WQGPG = PO4DWQ(L) / (WQKHPG+PO4DWQ(L)+ 1.E-18) + XLIMNC(L,K) = XLIMNC(L,K) + WQGNC + XLIMND(L,K) = XLIMND(L,K) + WQGND + XLIMNG(L,K) = XLIMNG(L,K) + WQGNG + XLIMPC(L,K) = XLIMPC(L,K) + WQGPC + XLIMPD(L,K) = XLIMPD(L,K) + WQGPD + XLIMPG(L,K) = XLIMPG(L,K) + WQGPG + IF(IDNOTRVA.GT.0 .AND. K.EQ.1)THEN + WQGNM = RNH4NO3(L) / (WQKHNM+RNH4NO3(L) + 1.E-18) + WQGPM = PO4DWQ(L) / (WQKHPM+PO4DWQ(L) + 1.E-18) + WQF1NM = MIN(WQGNM, WQGPM) + XLIMNM(L,K) = XLIMNM(L,K) + WQGNM + XLIMPM(L,K) = XLIMPM(L,K) + WQGPM + ENDIF + WQF1NC = MIN(WQGNC, WQGPC) + IF(IWQSI.EQ.1)THEN + SADWQ = MAX (WQSAD(L,K), 0.0) + WQGSD = SADWQ / (WQKHS+SADWQ+ 1.E-18) + WQF1ND = MIN(WQGND, WQGPD, WQGSD) + ELSE + WQF1ND = MIN(WQGND, WQGPD) + ENDIF + WQF1NG = MIN(WQGNG, WQGPG) + IF(IDNOTRVA.GT.0)THEN + PO4DWQ(L) = MAX (WQPO4D(L,K), 0.0) + ENDIF +!{ GEOSR X-species : jgcho 2015.09.24 + do nsp=1,NXSP + WQGNX(nsp)=RNH4NO3(L) / (WQKHNX(nsp)+RNH4NO3(L)+ 1.E-18) + WQGPX(nsp)=PO4DWQ(L) / (WQKHPX(nsp)+PO4DWQ(L)+ 1.E-18) + XLIMNX(L,K,nsp) = XLIMNX(L,K,nsp) + WQGNX(nsp) + XLIMPX(L,K,nsp) = XLIMPX(L,K,nsp) + WQGPX(nsp) + if (IWQX(nsp).eq.1) then ! cyano + WQF1NX(nsp) = MIN(WQGNX(nsp), WQGPX(nsp)) + endif + WQF1NX(nsp) = MIN(WQGNC, WQGPC) + if (IWQSI.EQ.1 .and. IWQX(nsp).eq.2) then ! diatom + SADWQ = MAX (WQSAD(L,K), 0.0) + WQGSD = SADWQ / (WQKHSX(nsp)+SADWQ+ 1.E-18) + WQF1NX(nsp) = MIN(WQGNX(nsp), WQGPX(nsp),WQGSD) + else + WQF1NX(nsp) = MIN(WQGNX(nsp), WQGPX(nsp)) + endif + enddo +!} GEOSR X-species : jgcho 2015.09.24 +C +C IN C&C, F2IC=F2IC/FCYAN, FACTOR TO ALLOW CYANOBACTERIA MAT FORMATION +C + IF(SOLSWRT(L).GE.0.001)THEN + IF(USESHADE)THEN + WQI0 = PARADJ*2.065*SOLSWRT(L) + ENDIF + XMRM = WQKECHL*WQCHL(L,K) + IF(WQKECHL .LT. 0.0)THEN + XMRM = 0.054*WQCHL(L,K)**0.6667 + 0.0088*WQCHL(L,K) + ENDIF + WQKESS = WQKEB(IMWQZT(L))+WQKETSS*SEDT(L,K) + XMRM + WQKESS1 = WQKESS + IF(K.NE.KC)THEN + XMRM = WQKECHL*WQCHL(L,KC) + IF(WQKECHL .LT. 0.0)THEN + XMRM = 0.054*WQCHL(L,KC)**0.6667 + 0.0088*WQCHL(L,KC) + ENDIF + WQKESS1=WQKEB(IMWQZT(L))+WQKETSS*SEDT(L,KC) + XMRM + ENDIF +C +C COMPUTE SECCHI DEPTH FOR USE AS OUTPUT VARIABLE: +C + WQKETOT(L,K) = WQKESS + WQAVGIO = WQCIA*WQI0 + WQCIB*WQI1 + WQCIC*WQI2 + IF(IWQSUN .EQ. 2)THEN + WQAVGIO = WQCIA*WQI1 + WQCIB*WQI2 + WQCIC*WQI3 + ENDIF + WQISC = MAX( WQAVGIO*EXP(-WQKESS1*WQDOPC), WQISMIN ) + WQISD = MAX( WQAVGIO*EXP(-WQKESS1*WQDOPD), WQISMIN ) + WQISG = MAX( WQAVGIO*EXP(-WQKESS1*WQDOPG), WQISMIN ) + WQTT1 = (CNS1 * WQFD * DZWQ(L)) / WQKESS +C +C WQFDI0 = - WQI0 / (WQFD+ 1.E-18) +C + WQFDI0 = - WQI0BOT(L) / (WQFD + 1.E-18) + WQFDC = WQFDI0 / (WQISC + 1.E-18) + WQFDD = WQFDI0 / (WQISD + 1.E-18) + WQFDG = WQFDI0 / (WQISG + 1.E-18) + WQHTT = WQHT(K) * HP(L) + WQTTB = EXP( -WQKESS * (WQHTT+1.0/DZWQ(L)) ) + WQTTT = EXP( -WQKESS * WQHTT ) + WQF2IC = WQTT1 * (EXP(WQFDC*WQTTB) - EXP(WQFDC*WQTTT)) + WQF2ID = WQTT1 * (EXP(WQFDD*WQTTB) - EXP(WQFDD*WQTTT)) + WQF2IG = WQTT1 * (EXP(WQFDG*WQTTB) - EXP(WQFDG*WQTTT)) + !WQF2IC = WQF2IC * PSHADE(L) + !WQF2ID = WQF2ID * PSHADE(L) + !WQF2IG = WQF2IG * PSHADE(L) + XLIMIC(L,K) = XLIMIC(L,K) + WQF2IC + XLIMID(L,K) = XLIMID(L,K) + WQF2ID + XLIMIG(L,K) = XLIMIG(L,K) + WQF2IG +!{ GEOSR X-species : jgcho 2015.09.25 + do nsp=1,NXSP + WQISX(nsp) = MAX( WQAVGIO*EXP(-WQKESS1*WQDOPX(nsp)) + & , WQISMIN ) + WQFDX(nsp) = WQFDI0 / (WQISX(nsp) + 1.E-18) + WQF2IX(nsp) = WQTT1 * (EXP(WQFDX(nsp)*WQTTB) + & - EXP(WQFDX(nsp)*WQTTT)) + XLIMIX(L,K,nsp) = XLIMIX(L,K,nsp) + WQF2IX(nsp) + enddo +!} GEOSR X-species : jgcho 2015.09.25 + ELSE + WQF2IC=0.0 + WQF2ID=0.0 + WQF2IG=0.0 +!{ GEOSR X-species : jgcho 2015.09.25 + do nsp=1,NXSP + WQF2IX(nsp) = 0. + enddo +!} GEOSR X-species : jgcho 2015.09.25 + ENDIF +!{ GEOSR STOKES : YSSONG 2015.08.18 + !{ GEOSR STOKES X : jgcho 2015.10.13 + do nsp=1,NXSP + IF(ISSTOKEX(nsp).GE.1)THEN + CALL WQSTOKES01(WQKESS1,L,K,nsp) + ELSE + WQALSETX(L,KC,nsp) = WQBXSET(L,1,nsp) + IF(K.NE.KC) WQALSETX(L,K,nsp) = WQBXSET(L,2,nsp) + ENDIF + enddo + !} GEOSR STOKES X : jgcho 2015.10.13 +!} GEOSR STOKES : YSSONG 2015.08.18 +C +C UPDATE SOLAR RADIATION AT BOTTOM OF THIS LAYER +C + IF (WQKESS.LT.1.0E-12) WQKESS=0. + IF (WQKESS1.LT.1.0E-12) WQKESS1=0. + WQI0BOT(L)=WQI0BOT(L)*EXP(-WQKESS*(1.0/DZWQ(L))) + IF(IDNOTRVA.GT.0 .AND. K.EQ.1)THEN + WQFDI0 = - WQI0BOT(L) / (WQFD + 1.E-18) + WQISM = MAX( WQAVGIO*EXP(-WQKESS1*WQDOPM(IZ)), WQISMIN ) + WQFDM = WQFDI0 / (WQISM + 1.E-18) + WQF2IM = WQTT1 * (EXP(WQFDM*WQTTB) - EXP(WQFDM*WQTTT)) + !WQF2IM = WQF2IM * PSHADE(L) + UMRM = MAX(U(L,K), U(L+1,K)) + VMRM = MAX(V(L,K), V(LNC(L),K)) + WQVEL=SQRT(UMRM*UMRM + VMRM*VMRM) + WQLVF=1.0 +C +C OPTION 1 FOR VELOCITY LIMITATION ASSUMES MACROALGAE GROWTH +C IS LIMITED AT LOW VELOCITIES DUE TO REDUCED AVAILABILITY OF +C NUTRIENTS REACHING THE ALGAE BIOMASS. USES A MICHAELIS-MENTON +C TYPE OF EQUATION. +C + IF(IWQVLIM .EQ. 1)THEN + IF(WQVEL .GT. WQKMVMIN(L))THEN + WQLVF = WQVEL / (WQKMV(L) + WQVEL) + ELSE + WQLVF = WQKMVMIN(L) / (WQKMV(L) + WQKMVMIN(L)) + ENDIF + ENDIF +C +C OPTION 2 FOR VELOCITY LIMITATION APPLIES A FIVE-PARAMETER LOGISTIC +C FUNCTION THAT CAN BE ADJUSTED TO LIMIT MACROALGAE GROWTH FOR +C EITHER LOW OR HIGH (SCOUR) VELOCITIES. IN STREAMS WITH LOW NUTRIENTS, +C THE LOW VELOCITY WILL LIKELY BE LIMITING SINCE AMPLE NUTRIENTS MAY +C NOT REACH THE ALGAE BIOMASS DUE TO REDUCED FLOW. IN STREAMS WITH +C ABUNDANT NUTRIENTS, LOW VELOCITIES WILL NOT LIMIT MACROALGAE GROWTH, +C INSTEAD, HIGH VELOCITIES WILL LIKELY SCOUR THE MACROALGAE AND DETACH +C IT FROM THE SUBSTRATE. +C + IF(IWQVLIM .EQ.2)THEN + XNUMER = WQKMVA(L) - WQKMVD(L) + XDENOM = 1.0 + (WQVEL/WQKMVC(L))**WQKMVB(L) + WQLVF = WQKMVD(L) + ( XNUMER / (XDENOM**WQKMVE(L)) ) + ENDIF +C +C USE THE MORE SEVERELY LIMITING OF VELOCITY OR NUTRIENT FACTORS: +C + XMRM = MIN(WQLVF, WQF1NM) + WQF1NM = XMRM +C +C FIRST CONVERT FROM MACROALGAE FROM A CONCENTRATION (MG C/M3) +C TO A DENSITY (MG C/M2). +C + XMRM = WQVO(L,K,IDNOTRVA)*DZC(K)*HP(L) + WQLDF = WQKBP(L) / (WQKBP(L) + XMRM) + WQPM(L)= WQPMM(IMWQZT(L))*WQF1NM*WQF2IM*WQTDGM(IWQT(L))* + & WQLDF + XLIMVM(L,K) = XLIMVM(L,K) + WQLVF + XLIMDM(L,K) = XLIMDM(L,K) + WQLDF + XLIMIM(L,K) = XLIMIM(L,K) + WQF2IM + XLIMTM(L,K) = XLIMTM(L,K) + WQTDGM(IWQT(L)) + ENDIF + XLIMTC(L,K) = XLIMTC(L,K) + WQTDGC(IWQT(L)) + XLIMTD(L,K) = XLIMTD(L,K) + WQTDGD(IWQT(L)) + XLIMTG(L,K) = XLIMTG(L,K) + WQTDGG(IWQT(L)) +!{ GEOSR X-species : jgcho 2015.09.25 + do nsp=1,NXSP + XLIMTX(L,K,nsp) = XLIMTX(L,K,nsp) + WQTDGX(IWQT(L),nsp) + enddo +!} GEOSR X-species : jgcho 2015.09.25 +C +C: WQSTOX=WQSTOX**2 +C + IF(IWQSTOX.EQ.1)THEN + WQF4SC = WQSTOX / (WQSTOX + SWQ(L)*SWQ(L)+1.E-12) + WQPC(L)=WQPMC(IMWQZT(L))*WQF1NC*WQF2IC*WQTDGC(IWQT(L)) + & *WQF4SC + ELSE + WQPC(L) = WQPMC(IMWQZT(L))*WQF1NC*WQF2IC*WQTDGC(IWQT(L)) + ENDIF + !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 +! WQPD(L) = WQPMD(IMWQZT(L))*WQF1ND*WQF2ID*WQTDGD(IWQT(L)) +! WQPG(L) = WQPMG(IMWQZT(L))*WQF1NG*WQF2IG*WQTDGG(IWQT(L)) + if (IWQDGSTOX.eq.1) then + tdiff=WQSALB(1)-WQSALA(1) + wctm1=( WQSALB(1) - SWQ(L) )/tdiff + wctm2=( SWQ(L) - WQSALA(1) )/tdiff + WQFDGSC(1)=wctm1*WQCOEFSA(1) + wctm2*WQCOEFSB(1) + if (WQFDGSC(1).lt.WQCOEFSA(1)) WQFDGSC(1)=WQCOEFSA(1) + if (WQFDGSC(1).gt.WQCOEFSB(1)) WQFDGSC(1)=WQCOEFSB(1) + + tdiff=WQSALB(2)-WQSALA(2) + wctm1=(WQSALB(2)-SWQ(L))/tdiff + wctm2=(SWQ(L)-WQSALA(2))/tdiff + WQFDGSC(2)=wctm1*WQCOEFSA(2) + wctm2*WQCOEFSB(2) + if (WQFDGSC(2).lt.WQCOEFSA(2)) WQFDGSC(2)=WQCOEFSA(2) + if (WQFDGSC(2).gt.WQCOEFSB(2)) WQFDGSC(2)=WQCOEFSB(2) + + WQPD(L) = WQPMD(IMWQZT(L))*WQF1ND*WQF2ID*WQTDGD(IWQT(L)) + & *WQFDGSC(1) + WQPG(L) = WQPMG(IMWQZT(L))*WQF1NG*WQF2IG*WQTDGG(IWQT(L)) + & *WQFDGSC(2) + else + WQPD(L) = WQPMD(IMWQZT(L))*WQF1ND*WQF2ID*WQTDGD(IWQT(L)) + WQPG(L) = WQPMG(IMWQZT(L))*WQF1NG*WQF2IG*WQTDGG(IWQT(L)) + endif + !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 +!{ GEOSR X-species : jgcho 2015.09.25 + do nsp=1,NXSP + IF(IWQSTOX.EQ.1 .and. IWQX(nsp).eq.1)THEN + WQF4SC = WQSTOXX(nsp) / (WQSTOXX(nsp) + & + SWQ(L)*SWQ(L)+1.E-12) + WQPX(L,nsp)=WQPMX(IMWQZT(L),nsp)*WQF1NX(nsp)*WQF2IX(nsp) + & *WQTDGX(IWQT(L),nsp)*WQF4SC + ENDIF +! WQPX(L,nsp) = WQPMX(IMWQZT(L),nsp)*WQF1NX(nsp)*WQF2IX(nsp) +! & *WQTDGX(IWQT(L),nsp) + !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + IF(IWQDGSTOX.eq.1 .and. IWQX(nsp).ge.2)THEN + tdiff=WQSALBX(nsp)-WQSALAX(nsp) + wctm1=(WQSALBX(nsp)-SWQ(L))/tdiff + wctm2=(SWQ(L)-WQSALAX(nsp))/tdiff + WQFDGSCX=wctm1*WQCOEFSAX(nsp) + wctm2*WQCOEFSBX(nsp) + if (WQFDGSCX.lt.WQCOEFSAX(nsp)) WQFDGSCX=WQCOEFSAX(nsp) + if (WQFDGSCX.gt.WQCOEFSBX(nsp)) WQFDGSCX=WQCOEFSBX(nsp) + + WQPX(L,nsp) = WQPMX(IMWQZT(L),nsp)*WQF1NX(nsp)*WQF2IX(nsp) + & *WQTDGX(IWQT(L),nsp)*WQFDGSCX + ELSE ! IF(IWQDGSTOX.eq.1)THEN + WQPX(L,nsp) = WQPMX(IMWQZT(L),nsp)*WQF1NX(nsp)*WQF2IX(nsp) + & *WQTDGX(IWQT(L),nsp) + ENDIF ! IF(IWQDGSTOX.eq.1)THEN + !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + enddo +!} GEOSR X-species : jgcho 2015.09.25 +C +C AT NIGHT, I.E., WHEN SOLAR RADIATION IS LESS THAN 0.001 (05/11/99 +C + IF(IWQSUN .EQ. 2)THEN + IF(WQI0 .LE. 0.001)THEN + WQPC(L) = 0.0 + WQPD(L) = 0.0 + WQPG(L) = 0.0 +!{ GEOSR X-species : jgcho 2015.09.25 + do nsp=1,NXSP + WQPX(L,nsp) = 0.0 + enddo +!} GEOSR X-species : jgcho 2015.09.25 + WQPM(L) = 0.0 + ENDIF + ENDIF +C +C ALGAL BASAL METABOLISM & PREDATION +C + WQBMC(L) = WQBMRC(IMWQZT(L)) * WQTDRC(IWQT(L)) + WQPRC(L) = WQPRRC(IMWQZT(L)) * WQTDRC(IWQT(L)) +C +C THE VARIABLE WQTDGP ADJUSTS PREDATION AND BASAL METABOLISM BASED ON A +C LOWER/UPPER OPTIMUM TEMPERATURE FUNCTION. THIS WILL ALLOW DIATOMS TO +C BLOOM IN WINTER IF WQTDGP IS CLOSE TO ZERO. +C + WQBMD(L)=WQBMRD(IMWQZT(L))*WQTDRD(IWQT(L))*WQTDGP(IWQT(L)) + WQPRD(L)=WQPRRD(IMWQZT(L))*WQTDRD(IWQT(L))*WQTDGP(IWQT(L)) + WQBMG(L) = WQBMRG(IMWQZT(L)) * WQTDRG(IWQT(L)) + WQPRG(L) = WQPRRG(IMWQZT(L)) * WQTDRG(IWQT(L)) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQBMM(L) = WQBMRM(IMWQZT(L)) * WQTDRM(IWQT(L)) + WQPRM(L) = WQPRRM(IMWQZT(L)) * WQTDRM(IWQT(L)) + ENDIF +!{ GEOSR X-species : jgcho 2015.09.30 + do nsp=1,NXSP +! if (IWQX(nsp).eq.2) then + WQBMX(L,nsp) = WQBMRX(IMWQZT(L),nsp)*WQTDRX(IWQT(L),nsp) + & *WQTDGPX(IWQT(L),nsp) + WQPRX(L,nsp) = WQPRRX(IMWQZT(L),nsp)*WQTDRX(IWQT(L),nsp) + & *WQTDGPX(IWQT(L),nsp) +! endif +! WQBMX(L,nsp) = WQBMRX(IMWQZT(L),nsp) * WQTDRX(IWQT(L),nsp) +! WQPRX(L,nsp) = WQPRRX(IMWQZT(L),nsp) * WQTDRX(IWQT(L),nsp) + enddo +!} GEOSR X-species : jgcho 2015.09.30 + ENDDO +C +C END HORIZONTAL LOOP FOR ALGAE PARMETERS +C + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + WQOBTOT(L) = WQVO(L,K,1)+WQVO(L,K,2)+WQVO(L,K,3) +!{ GEOSR X-species : jgcho 2015.09.30 + do nsp=1,NXSP + WQOBTOT(L) = WQOBTOT(L) + WQVOX(L,K,nsp) + enddo +!} GEOSR X-species : jgcho 2015.09.30 + WQKRPC(L) = (WQKRC + WQKRCALG*WQOBTOT(L)) * WQTDHDR(IWQT(L)) + WQKLPC(L) = (WQKLC + WQKLCALG*WQOBTOT(L)) * WQTDHDR(IWQT(L)) + XMRM = 0.0 + IF(IDNOTRVA.GT.0 .AND. K.EQ.1)THEN + XMRM = WQKDCALM(IZ) * WQVO(L,K,IDNOTRVA) + ENDIF +C +C M. MORTON 08/28/99: ADDED SPATIALLY VARIABLE DOC HYDROLYSIS RATE WQKDC +C TO ACHIEVE BETTER CONTROL IN SYSTEMS WITH A COMBINATION OF FRESHWAT +C STREAMS AND TIDAL RIVERS WITH DIFFERENT CHARACTERISTICS. +C + WQKDOC=(WQKDC(IZ)+WQKDCALG*WQOBTOT(L)+XMRM)*WQTDMNL(IWQT(L)) + O2WQ(L) = MAX(WQVO(L,K,19), 0.0) + WQTT1 = WQKDOC / (WQKHORDO + O2WQ(L)+ 1.E-18) + WQKHR(L) = WQTT1 * O2WQ(L) + WQDENIT(L)=WQTT1*WQAANOX*RNO3WQ(L)/(WQKHDNN+RNO3WQ(L)+1.E-18) + ENDDO +C +C 7-10 PHOSPHORUS +C +!{ GEOSR X-species : jgcho 2015.09.30 + WQKHP = 0. + do nsp=1,NXSP + WQKHP = WQKHP + WQKHPX(nsp) + enddo + WQKHP = (WQKHP+WQKHPC+WQKHPD+WQKHPG)/float(NXSP+3) +!} GEOSR X-species : jgcho 2015.09.30 + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + WQAPC(L)=1.0/(WQCP1PRM+WQCP2PRM*EXP(-WQCP3PRM*PO4DWQ(L))) +! WQKHP = (WQKHPC+WQKHPD+WQKHPG) / 3.0 ! GEOSR X-species : jgcho 2015.09.30 + WQTT1 = WQKHP / (WQKHP+PO4DWQ(L)+ 1.E-18) * WQOBTOT(L) + WQKRPP(L) = (WQKRP + WQKRPALG*WQTT1) * WQTDHDR(IWQT(L)) + WQKLPP(L) = (WQKLP + WQKLPALG*WQTT1) * WQTDHDR(IWQT(L)) + WQKDOP(L) = (WQKDP + WQKDPALG*WQTT1) * WQTDMNL(IWQT(L)) + ENDDO + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + IF(IWQSRP.EQ.1)THEN + WQTTM = WQKPO4P*WQTAMP(L,K) + WQH10(L) = - WQWSSET(L,1) * WQTTM / (1.0+WQTTM) + IF(K.NE.KC)THEN + WQTTM = WQKPO4P*WQTAMP(L,K+1) + WQT10(L) = WQWSSET(L,2) * WQTTM / (1.0+WQTTM) + ENDIF + ELSE IF(IWQSRP.EQ.2)THEN + WQTTS = WQKPO4P*SEDT(L,K) + WQH10(L) = - WSEDO(NS) * WQTTS * DZWQ(L) / (1.0+WQTTS) + IF(K.NE.KC)THEN + WQTTS = WQKPO4P*SEDT(L,K) + WQT10(L) = WSEDO(NS) * WQTTS * DZWQ(L) / (1.0+WQTTS) + ENDIF + ELSE + WQH10(L) = 0.0 + WQT10(L) = 0.0 + ENDIF + ENDDO +C +C 11-15 NITROGEN +C +!{ GEOSR X-species : jgcho 2015.09.30 + WQKHN = 0. + do nsp=1,NXSP + WQKHN = WQKHN + WQKHNX(nsp) + enddo + WQKHN = (WQKHN+WQKHNC+WQKHND+WQKHNG)/float(NXSP+3) +!} GEOSR X-species : jgcho 2015.09.30 + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +! WQKHN = (WQKHNC+WQKHND+WQKHNG) / 3.0 + WQTT1 = WQKHN / (WQKHN+RNH4NO3(L)+ 1.E-18) * WQOBTOT(L) + WQKRPN(L) = (WQKRN + WQKRNALG*WQTT1) * WQTDHDR(IWQT(L)) + WQKLPN(L) = (WQKLN + WQKLNALG*WQTT1) * WQTDHDR(IWQT(L)) + WQKDON(L) = (WQKDN + WQKDNALG*WQTT1) * WQTDMNL(IWQT(L)) + ENDDO + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + IF(RNH4NO3(L).EQ.0.0)THEN + WQPNC(L)=0.0 + WQPND(L)=0.0 + WQPNG(L)=0.0 + WQPNM(L)=0.0 +!{ GEOSR X-species : jgcho 2015.09.30 + do nsp=1,NXSP + WQPNX(L,nsp)=0.0 + enddo +!} GEOSR X-species : jgcho 2015.09.30 + ELSE + WQTTC = RNH4WQ(L)/(WQKHNC+RNO3WQ(L)+ 1.E-18) + WQTTD = RNH4WQ(L)/(WQKHND+RNO3WQ(L)+ 1.E-18) + WQTTG = RNH4WQ(L)/(WQKHNG+RNO3WQ(L)+ 1.E-18) + WQTTM = RNH4WQ(L)/(WQKHNM+RNO3WQ(L)+ 1.E-18) + WQPNC(L) = (RNO3WQ(L)/(WQKHNC+RNH4WQ(L)+ 1.E-18) + & + WQKHNC/(RNH4NO3(L)+ 1.E-18)) * WQTTC + WQPND(L) = (RNO3WQ(L)/(WQKHND+RNH4WQ(L)+ 1.E-18) + & + WQKHND/(RNH4NO3(L)+ 1.E-18)) * WQTTD + WQPNG(L) = (RNO3WQ(L)/(WQKHNG+RNH4WQ(L)+ 1.E-18) + & + WQKHNG/(RNH4NO3(L)+ 1.E-18)) * WQTTG + WQPNM(L) = (RNO3WQ(L)/(WQKHNM+RNH4WQ(L)+ 1.E-18) + & + WQKHNM/(RNH4NO3(L)+ 1.E-18)) * WQTTM +!{ GEOSR X-species : jgcho 2015.09.30 + do nsp=1,NXSP + WQTTX(nsp) = RNH4WQ(L)/(WQKHNX(nsp)+RNO3WQ(L)+ 1.E-18) + WQPNX(L,nsp) = (RNO3WQ(L)/(WQKHNX(nsp)+RNH4WQ(L)+ 1.E-18) + & + WQKHNX(nsp)/(RNH4NO3(L)+ 1.E-18)) * WQTTX(nsp) + enddo +!} GEOSR X-species : jgcho 2015.09.30 + ENDIF + WQNIT(L) = O2WQ(L) * WQTDNIT(IWQT(L)) / + & ( (WQKHNDO+O2WQ(L)) * (WQKHNN+RNH4WQ(L)) + 1.E-18) + ENDDO + IF(IWQSI.EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + IF(IWQSRP.EQ.1)THEN + WQTTM = WQKSAP*WQTAMP(L,K) + WQN17(L) = - WQWSSET(L,1) * WQTTM / (1.0+WQTTM) + IF(K.NE.KC)THEN + WQTTM = WQKSAP*WQTAMP(L,K+1) + WQT17(L) = WQWSSET(L,2) * WQTTM / (1.0+WQTTM) + ENDIF + ELSE IF(IWQSRP.EQ.2)THEN + WQTTS = WQKSAP*SEDT(L,K) + WQN17(L) = - WSEDO(NS) * WQTTS * DZWQ(L) / (1.0+WQTTS) + IF(K.NE.KC)THEN + WQTTS = WQKSAP*SEDT(L,K+1) + WQT17(L) = WSEDO(NS) * WQTTS * DZWQ(L) / (1.0+WQTTS) + ENDIF + ELSE + WQN17(L) = 0.0 + WQT17(L) = 0.0 + ENDIF + ENDDO + ENDIF +C +C 04/29/99 MRM: +C THE FOLLOWING ARRAYS WERE ADDED TO KEEP TRACK OF THE VARIOUS COMPONENT +C OF DISSOLVED OXYGEN. THE INSTANTANEOUS VALUES FOR EACH COMPONENT ARE +C SUMMED IN THE ARRAYS AND THEN DUMPED TO THE WQDOCOMP.BIN FILE AT THE +C SAME TIME INTERVAL AS FOR THE WQWCAVG.BIN FILES (I.E., IWQTSDT INTERVA +C USUALLY DAILY AVERAGES). THE ARRAY DESCRIPTIONS ARE: +C XDOSOD(L,K) = D.O. COMPONENT FOR SEDIMENT OXYGEN DEMAND +C XDOKAR(L,K) = D.O. COMPONENT FOR REAERATION +C XDODOC(L,K) = D.O. COMPONENT FOR DISS. ORG. CARBON DECAY +C XDONIT(L,K) = D.O. COMPONENT FOR AMMONIA NITRIFICATION +C XDOCOD(L,K) = D.O. COMPONENT FOR CHEM. OXY. DEMAND OXIDATION +C XDOPPB(L,K) = D.O. COMPONENT FOR PHOTOSYNTHESIS OF TOTAL CHLOROPHYLL +C XDORRB(L,K) = D.O. COMPONENT FOR RESPIRATION OF TOTAL CHLOROPHYLL +C XDOPPM(L,K) = D.O. COMPONENT FOR PHOTOSYNTHESIS OF MACROALGAE +C XDORRM(L,K) = D.O. COMPONENT FOR RESPIRATION OF MACROALGAE +C XDOALL(L,K) = SUM OF THE ABOVE 10 D.O. COMPONENTS +C NLIM = COUNTER FOR NUMBER OF ITEMS SUMMED IN EACH ARRAY SLOT +C + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) + WQO18(L)= -DTWQO2*WQKCOD(IWQT(L),IZ)*O2WQ(L) / + & (WQKHCOD(IZ) + O2WQ(L) + 1.E-18) +C +C TT THE FOLLOWING MODIFICATION TO THE D.O. SATURATION CALCULATION MADE +C TT BY J.M. HAMRICK / M.R. MORTON ON 03/08/97. SEE CHAPRA (1997) PG. 3 +C + TVAL1=1./(TWQ(L)+273.15) + TVAL2=TVAL1*TVAL1 + TVAL3=TVAL1*TVAL2 + TVAL4=TVAL2*TVAL2 + RLNSAT1=-139.3441+(1.575701E+5*TVAL1)-(6.642308E+7*TVAL2) + & +(1.2438E+10*TVAL3)-(8.621949E+11*TVAL4) + RLNSAT2=RLNSAT1-SWQ(L)*( 1.7674E-2-(1.0754E+1*TVAL1) + & +(2.1407E+3*TVAL2) ) + WQDOS(L) = EXP(RLNSAT2) + XDOSAT(L,K) = XDOSAT(L,K) + WQDOS(L)*DTWQ*DZC(K)*HP(L) + IF(K.EQ.KC)THEN +C +C IN THE FOLLOWING EQUATION, SALINITY MUST BE IN MG/L, HENCE, SWQ(L) +C IS MULTIPLIED BY 1000. +C WQDOS = 14.5532 - 0.38217*TVAL1 + 5.4258E-3*TVAL2 - +C DO NOT ALLOW WIND SPEEDS ABOVE 11 M/SEC IN THE FOLLOWING EQUATION: +C + WINDREA = WINDST(L) + WQWREA=0.728*SQRT(WINDREA)+(0.0372*WINDREA-0.317)*WINDREA +C +C WQWREA = 0.728*SQRT(WINDST(L)) +C + IF(IWQKA(IZ) .EQ. 0)THEN + WQVREA = WQKRO(IZ) + WQWREA = 0.0 + ENDIF +C +C WIND VELOCITY COMPUTED ABOVE: +C + IF(IWQKA(IZ) .EQ. 1)THEN + WQVREA = WQKRO(IZ) + ENDIF +C +C WQKRO = 3.933 TYPICALLY +C + IF(IWQKA(IZ) .EQ. 2)THEN + UMRM = 0.5*(U(L,K)+U(L+1,K)) + VMRM = 0.5*(V(L,K)+V(LNC(L),K)) + XMRM = SQRT(UMRM*UMRM + VMRM*VMRM) + WQVREA = WQKRO(IZ) * XMRM**0.5 / HP(L)**0.5 + ENDIF +C +C WQKRO = 5.32 TYPICALLY +C + IF(IWQKA(IZ) .EQ. 3)THEN + UMRM = MAX(U(L,K), U(L+1,K)) + VMRM = MAX(V(L,K), V(LNC(L),K)) + XMRM = SQRT(UMRM*UMRM + VMRM*VMRM) + WQVREA = WQKRO(IZ) * XMRM**0.67 / HP(L)**1.85 + ENDIF +C +C MODIFIED OWENS AND GIBBS REAERATION EQUATION: +C NOTE: NORMALIZED TO A DEPTH OF 1.0 FT, I.E., THIS EQUATION GIVES THE +C SAME REAERATION AS OWENS & GIBBS AT 1.0 FT DEPTH; AT HIGHER +C DEPTHS IT GIVES LARGER REAERATION THAN OWENS & GIBBS. +C WQKRO = 5.32 TYPICALLY +C + IF(IWQKA(IZ) .EQ. 4)THEN + UMRM = MAX(U(L,K), U(L+1,K)) + VMRM = MAX(V(L,K), V(LNC(L),K)) + XMRM = SQRT(UMRM*UMRM + VMRM*VMRM) + YMRM = HP(L)*3.0*(1.0 - HP(L)/(HP(L)+0.1524)) + WQVREA = WQKRO(IZ) * XMRM**0.67 / YMRM**1.85 + ENDIF +C +C NOW COMBINE REAERATION DUE TO WATER VELOCITY AND WIND STRESS: +C + WQVREA = WQVREA * REAC(IZ) + WQWREA = WQWREA * REAC(IZ) + WQP19(L)=-(WQVREA+WQWREA)*DZWQ(L)*WQTDKR(IWQT(L),IZ) + WQKRDOS(L) = - WQP19(L)*WQDOS(L) + ELSE + WQP19(L) = 0.0 + ENDIF + ENDDO + IF(IWQSRP.EQ.1)THEN + DO L=LMPI2,LMPILA + WQR20(L) = (WQWDSL(L,K,20)+WQWPSL(L,K,20))*VOLWQ(L) + & + (WQVO(L,K,20) - WQTAMP(L,K)) * WQWSSET(L,1) + IF(K.EQ.KC)THEN + WQR20(L) = WQR20(L) + WQATML(L,KC,20) * VOLWQ(L) + ENDIF + IF(K.EQ.1) WQR20(L) = WQR20(L) + & + WQTDTAM(IWQT(L))*DZWQ(L)/(WQKHBMF+O2WQ(L)+ 1.E-18) + IF(K.NE.KC) WQR20(L) = WQR20(L) + & + (WQVO(L,K+1,20) - WQTAMP(L,K+1)) * WQWSSET(L,2) + ENDDO + ENDIF +C +C TRAPEZOIDAL SOLUTION OF KINETIC EQS: AFTER COMPUTING NEW VALUES, STORE +C WQVO+WQV INTO WQVO(L,K,NWQV) +C + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + DO L=LMPI2,LMPILA + WQA1C=(WQPM(L)-WQBMM(L)-WQPRM(L)-WQWSM*DZWQ(L))*DTWQO2 + WQVA1C = 1.0 / (1.0 - WQA1C) + WQV(L,K,IDNOTRVA)=(WQVO(L,K,IDNOTRVA)+WQA1C*WQVO(L, + & K,IDNOTRVA))*WQVA1C*SMAC(L) + WQV(L,K,IDNOTRVA) = MAX(WQV(L,K,IDNOTRVA),WQMCMIN)*SMAC(L) + WQVO(L,K,IDNOTRVA) = WQVO(L,K,IDNOTRVA)+WQV(L,K,IDNOTRVA) + ENDDO + ENDIF +C **** PARAM 01 ! cyano bacteria + IF(ISTRWQ(1).EQ.1)THEN +!{ GeoSR Bentic-cyano : JHLEE 2015.10.12 + IF(ISCYANO.EQ.1.AND.K.EQ.1) THEN + CALL Sub_SPORE(TIMTMP) + ENDIF +!} GeoSR Bentic-cyano : JHLEE 2015.10.12 + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP +C +!{ GEOSR STOKES : YSSONG 2015.08.18 + IF(WQBCSET(L,1).GE.0.0)THEN + WQA1C=(WQPC(L)-WQBMC(L)-WQPRC(L)-WQBCSET(L,1))*DTWQO2 + ELSE + IF(K.NE.KC)THEN + WQA1C=(WQPC(L)-WQBMC(L)-WQPRC(L)+WQBCSET(L,1))*DTWQO2 + ENDIF + ENDIF +!} + WQKK(L) = 1.0 / (1.0 - WQA1C) + !{ GEOSR X-species STOKES : jgcho 2015.10.13 + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then ! cyano + WQACX(nsp)=(WQPX(L,nsp)-WQBMX(L,nsp)-WQPRX(L,nsp)) + & *DTWQO2 ! GEOSR X-species : jgcho 2015.10.08 + IF(WQALSETX(L,K,nsp).GT.0.0)THEN !{ GEOSR STOKES : YSSONG 2015.08.18 !!!! SINK WQALSET(L,K,1) ! GEOSR X-species : jgcho 2015.10.08 + WQACX(nsp)=WQACX(nsp)-WQALSETX(L,K,nsp)*DTWQO2 ! GEOSR X-species : jgcho 2015.10.08 + ENDIF !{ GEOSR STOKES : YSSONG 2015.08.18 !!!! SINK + IF(WQALSETX(L,K,nsp).LT.0.0)THEN ! GEOSR X-species : jgcho 2015.10.08 + IF(K.NE.KC)THEN + WQACX(nsp)=WQACX(nsp)+WQALSETX(L,K,nsp)*DTWQO2 ! GEOSR X-species : jgcho 2015.10.08 + ENDIF + ENDIF + WQKKX(L,nsp) = 1.0 / (1.0 - WQACX(nsp)) + endif + enddo + !} GEOSR X-species STOKES : jgcho 2015.10.13 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR1C = (WQWDSL(L,K,1) + WQWPSL(L,K,1)) * VOLWQ(L) +!{ GEOSR X-species : jgcho 2015.10.01 +! GEOSR X-species : jgcho 2015.10. 5 not use WQWDSL, WQWPSL +!} GEOSR X-species : jgcho 2015.10.01 + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR1C = WQR1C + WQATML(L,KC,1) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,1) + DTWQ*WQR1C + WQA1C*WQVO(L,K,1) +!{ GEOSR X-species : jgcho 2015.10.05 + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then ! cyano + WQRRX(L,nsp)=WQVOX(L,K,nsp) + WQACX(nsp)*WQVOX(L,K,nsp) +!{ GeoSR Bentic-cyano : JHLEE 2015.10.12 + IF(ISCYANO.EQ.1.AND.K.EQ.1)THEN + WQRRX(L,nsp) = WQRRX(L,nsp) + + & CYA_ADD(L)*DZWQ(L)*DTWQ + ENDIF +!} GeoSR Bentic-cyano : JHLEE 2015.10.12 + endif + enddo +!} GEOSR X-species : jgcho 2015.10.05 +!{ GEOSR STOKES : YSSONG 2015.08.18 + IF(K.NE.KC)THEN + IF(WQBCSET(L,1).GT.0.0)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQBCSET(L,1)*WQVOCB(L,K+1) ! ORG + endif + do nsp=1,NXSP + IF(WQALSETX(L,K+1,nsp).GT.0.0)THEN !!! SOURCE from UPPER LAYER ! GEOSR X-species : jgcho 2015.10.08 + WQRRX(L,nsp) = WQRRX(L,nsp) + & + DTWQO2*WQALSETX(L,K+1,nsp)*WQVOXB(L,K+1,nsp) !WQVOCBX(L,K+1,nsp) ! GEOSR X-species : jgcho 2015.10.08 + ENDIF + enddo + ENDIF + IF(K.NE.1)THEN + IF(WQBCSET(L,1).LT.0.0)THEN + WQRR(L) = WQRR(L) - DTWQO2*WQBCSET(L,1)*WQVOCB(L,K-1) ! ORG + endif + do nsp=1,NXSP + IF(WQALSETX(L,K-1,nsp).LT.0.0)THEN !!! SOURCE from LOWER LAYER ! GEOSR X-species : jgcho 2015.10.08 + WQRRX(L,nsp) = WQRRX(L,nsp) + & - DTWQO2*WQALSETX(L,K-1,nsp)*WQVOXB(L,K-1,nsp) ! GEOSR X-species : jgcho 2015.10.08 + ENDIF + enddo + ENDIF +!} GEOSR STOKES : YSSONG 2015.08.18 +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQBCSET(L,2)*WQVO(L,K+1,1) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,1)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L))*WQVO(L,K,1) + WQVO(L,K,1) = WQVO(L,K,1)+WQV(L,K,1) + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then + WQVX(L,K,nsp)=SCB(L)*(WQRRX(L,nsp)*WQKKX(L,nsp)) + & +(1.-SCB(L))*WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,1)=WQVO(L,K,1) + WQVO(L,K,1) = WQVO(L,K,1)+WQV(L,K,1) + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo + ENDIF + ENDDO +!} +C3301 format(i4,100e12.4) + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,1)=WQVO(L,K,1) + WQVO(L,K,1) = WQVO(L,K,1)+WQV(L,K,1) + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo + ENDDO + ENDIF +!{GEOSR STOKES : YSSONG 2015.08.18 + IF(NXSP.EQ.1)THEN ! FOR MASS CONSERVE TEST + DO L=LMPI2,LMPILA + CYANOMASS=CYANOMASS+WQVOX(L,K,1)*DZC(K)*HP(L)*DXYP(L) + ENDDO + ENDIF +!} +C **** PARAM 02 + IF(ISTRWQ(2).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP +C + WQA2D=(WQPD(L)-WQBMD(L)-WQPRD(L)-WQBDSET(L,1))*DTWQO2 + WQKK(L) = 1.0 / (1.0 - WQA2D) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQA2X(nsp)=(WQPX(L,nsp)-WQBMX(L,nsp) + & -WQPRX(L,nsp)-WQBXSET(L,1,nsp))*DTWQO2 + WQKKX(L,nsp) = 1.0 / (1.0 - WQA2X(nsp)) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR2D = (WQWDSL(L,K,2) + WQWPSL(L,K,2)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR2D = WQR2D + WQATML(L,KC,2) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,2) + DTWQ*WQR2D + WQA2D*WQVO(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.13 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQRRX(L,nsp)=WQVOX(L,K,nsp) + WQA2X(nsp)*WQVOX(L,K,nsp) + endif + enddo +!{ GEOSR X-species : jgcho 2015.10.13 +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQBDSET(L,2)*WQVO(L,K+1,2) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQRRX(L,nsp)=WQRRX(L,nsp) + DTWQO2*WQBXSET(L,2,nsp) + & *WQVOX(L,K+1,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDIF +C ENDDO +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQBDSET(L,2)*WQVO(L,K+1,2) +C ENDDO +C ENDIF +C DO L=2,LA +!} + WQV(L,K,2)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,2) + WQVO(L,K,2) = WQVO(L,K,2)+WQV(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQVX(L,K,nsp)=SCB(L)*(WQRRX(L,nsp)*WQKKX(L,nsp)) + & +(1.-SCB(L))*WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,2)=WQVO(L,K,2) + WQVO(L,K,2) = WQVO(L,K,2)+WQV(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,2)=WQVO(L,K,2) + WQVO(L,K,2) = WQVO(L,K,2)+WQV(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDDO + ENDIF +C **** PARAM 03 + IF(ISTRWQ(3).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP +C + WQA3G=(WQPG(L)-WQBMG(L)-WQPRG(L)-WQBGSET(L,1))*DTWQO2 + WQKK(L) = 1.0 / (1.0 - WQA3G) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQA3X(nsp)=(WQPX(L,nsp)-WQBMX(L,nsp) + & -WQPRX(L,nsp)-WQBXSET(L,1,nsp))*DTWQO2 + WQKKX(L,nsp) = 1.0 / (1.0 - WQA3X(nsp)) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR3G = (WQWDSL(L,K,3) + WQWPSL(L,K,3)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR3G = WQR3G + WQATML(L,KC,3) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,3) + DTWQ*WQR3G + WQA3G*WQVO(L,K,3) + !{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQRRX(L,nsp)=WQVOX(L,K,nsp) + WQA3X(nsp)*WQVOX(L,K,nsp) + endif + enddo + !} GEOSR X-species : jgcho 2015.10.10 +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQBGSET(L,2)*WQVO(L,K+1,3) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQRRX(L,nsp)=WQRRX(L,nsp) + DTWQO2*WQBXSET(L,2,nsp) + & *WQVOX(L,K+1,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQBGSET(L,2)*WQVO(L,K+1,3) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,3)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,3) + WQVO(L,K,3) = WQVO(L,K,3)+WQV(L,K,3) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQVX(L,K,nsp)=SCB(L)*(WQRRX(L,nsp)*WQKKX(L,nsp)) + & +(1.-SCB(L))*WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,3)=WQVO(L,K,3) + WQVO(L,K,3) = WQVO(L,K,3)+WQV(L,K,3) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,3)=WQVO(L,K,3) + WQVO(L,K,3) = WQVO(L,K,3)+WQV(L,K,3) +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + if (IWQX(nsp).eq.3) then + WQVX(L,K,nsp)=WQVOX(L,K,nsp) + WQVOX(L,K,nsp) = WQVOX(L,K,nsp)+WQVX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.10 + ENDDO + ENDIF +C **** PARAM 04 + IF(ISTRWQ(4).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS HYDROLYSIS SETTLING +C + WQB4 = - (WQKRPC(L)+WQRPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQB4) +C +C DEFINITIONS ALGAE PREDATION SOURCE OF RPOC +C + WQA4 = WQFCRP * (WQPRC(L)*WQVO(L,K,1) + & + WQPRD(L)*WQVO(L,K,2) + WQPRG(L)*WQVO(L,K,3)) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA4 = WQA4+WQFCRPM*WQPRM(L)*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + WQA4 = WQA4 + WQFCRP*(WQPRX(L,nsp)*WQVOX(L,K,nsp)) + enddo +!} GEOSR X-species : jgcho 2015.10.10 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR4 = (WQWDSL(L,K,4) + WQWPSL(L,K,4)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR4 = WQR4 + WQATML(L,KC,4) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,4) + DTWQ*WQR4 + DTWQO2*( WQA4 + & + WQB4*WQVO(L,K,4) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,4) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,4) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,4)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,4) + WQVO(L,K,4) = WQVO(L,K,4)+WQV(L,K,4) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,4)=WQVO(L,K,4) + WQVO(L,K,4) = WQVO(L,K,4)+WQV(L,K,4) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,4)=WQVO(L,K,4) + WQVO(L,K,4) = WQVO(L,K,4)+WQV(L,K,4) + ENDDO + ENDIF +C **** PARAM 05 + IF(ISTRWQ(5).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQC5 = - (WQKLPC(L)+WQLPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQC5) + WQA5 = WQFCLP * (WQPRC(L)*WQVO(L,K,1) + & + WQPRD(L)*WQVO(L,K,2) + WQPRG(L)*WQVO(L,K,3)) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA5 =WQA5 + WQFCLPM * WQPRM(L)*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + WQA5 = WQA5 + WQFCLP*(WQPRX(L,nsp)*WQVOX(L,K,nsp)) + enddo +!} GEOSR X-species : jgcho 2015.10.10 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR5 = (WQWDSL(L,K,5) + WQWPSL(L,K,5)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR5 = WQR5 + WQATML(L,KC,5) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,5) + DTWQ*WQR5 + DTWQO2*( WQA5 + & + WQC5*WQVO(L,K,5) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,5) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,5) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,5)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,5) + WQVO(L,K,5) = WQVO(L,K,5)+WQV(L,K,5) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,5)=WQVO(L,K,5) + WQVO(L,K,5) = WQVO(L,K,5)+WQV(L,K,5) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,5)=WQVO(L,K,5) + WQVO(L,K,5) = WQVO(L,K,5)+WQV(L,K,5) + ENDDO + ENDIF +C **** PARAM 06 + IF(ISTRWQ(6).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQD6 = - (WQKHR(L)+WQDENIT(L)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQD6) + O2WQ(L) = MAX(WQVO(L,K,19), 0.0) + WQA6C=(WQFCDC+CFCDCWQ*WQKHRC/(WQKHRC+O2WQ(L)+1.E-18)) + & *WQBMC(L) + WQA6D=(WQFCDD+CFCDDWQ*WQKHRD/(WQKHRD+O2WQ(L)+1.E-18)) + & *WQBMD(L) + WQA6G=(WQFCDG+CFCDGWQ*WQKHRG/(WQKHRG+O2WQ(L)+1.E-18)) + & *WQBMG(L) + WQA6 = ( WQA6C + WQFCDP*WQPRC(L) )*WQVO(L,K,1) + & + ( WQA6D + WQFCDP*WQPRD(L) )*WQVO(L,K,2) + & + ( WQA6G + WQFCDP*WQPRG(L) )*WQVO(L,K,3) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA6M=(WQFCDM+(1-WQFCDM)*WQKHRM(IZ) / + & (WQKHRM(IZ) + O2WQ(L) + 1.E-18))*WQBMM(L) + WQA6 =WQA6+ (WQA6M+ WQFCDPM*WQPRM(L))*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.10 + do nsp=1,NXSP + WQA6X=(WQFCDX(nsp)+CFCDWQX(nsp)*WQKHRX(nsp) + & /(WQKHRX(nsp)+O2WQ(L)+1.E-18))*WQBMX(L,nsp) + WQA6 = WQA6 + & + (WQA6X + WQFCDP*WQPRX(L,nsp))*WQVOX(L,K,nsp) + enddo +!} GEOSR X-species : jgcho 2015.10.10 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR6 = (WQWDSL(L,K,6) + WQWPSL(L,K,6)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR6 = WQR6 + WQATML(L,KC,6) * VOLWQ(L) + ENDIF + WQRR(L)=WQVO(L,K,6)+DTWQ*WQR6+DTWQO2*(WQA6+WQKRPC(L)* + & WQVO(L,K,4) + WQKLPC(L)*WQVO(L,K,5) + WQD6*WQVO(L,K,6) ) + WQV(L,K,6)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,6) + WQVO(L,K,6) = WQVO(L,K,6)+WQV(L,K,6) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,6)=WQVO(L,K,6) + WQVO(L,K,6) = WQVO(L,K,6)+WQV(L,K,6) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,6)=WQVO(L,K,6) + WQVO(L,K,6) = WQVO(L,K,6)+WQV(L,K,6) + ENDDO + ENDIF +C **** PARAM 07 + IF(ISTRWQ(7).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQE7 = - (WQKRPP(L)+WQRPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQE7) + WQA7C = (WQFPRC*WQBMC(L) + WQFPRP*WQPRC(L)) * WQVO(L,K,1) + WQA7D = (WQFPRD*WQBMD(L) + WQFPRP*WQPRD(L)) * WQVO(L,K,2) + WQA7G = (WQFPRG*WQBMG(L) + WQFPRP*WQPRG(L)) * WQVO(L,K,3) + WQA7 = (WQA7C+WQA7D+WQA7G) * WQAPC(L) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA7 = WQA7 + (WQFPRM*WQBMM(L) + WQFPRPM*WQPRM(L)) + & * WQVO(L,K,IDNOTRVA)* WQAPC(L)*WQAPCM + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA7X = (WQFPRX(nsp)*WQBMX(L,nsp) + WQFPRP*WQPRX(L,nsp)) + & * WQVOX(L,K,nsp) + WQA7 = WQA7 + WQA7X*WQAPC(L) + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR7 = (WQWDSL(L,K,7) + WQWPSL(L,K,7)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR7 = WQR7 + WQATML(L,KC,7) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,7) + DTWQ*WQR7 + DTWQO2*( WQA7 + & + WQE7*WQVO(L,K,7) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,7) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,7) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,7)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,7) + WQVO(L,K,7) = WQVO(L,K,7)+WQV(L,K,7) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,7)=WQVO(L,K,7) + WQVO(L,K,7) = WQVO(L,K,7)+WQV(L,K,7) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,7)=WQVO(L,K,7) + WQVO(L,K,7) = WQVO(L,K,7)+WQV(L,K,7) + ENDDO + ENDIF +C **** PARAM 08 + IF(ISTRWQ(8).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQF8 = - (WQKLPP(L)+WQLPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQF8) + WQA8C = (WQFPLC*WQBMC(L) + WQFPLP*WQPRC(L)) * WQVO(L,K,1) + WQA8D = (WQFPLD*WQBMD(L) + WQFPLP*WQPRD(L)) * WQVO(L,K,2) + WQA8G = (WQFPLG*WQBMG(L) + WQFPLP*WQPRG(L)) * WQVO(L,K,3) + WQA8 = (WQA8C+WQA8D+WQA8G) * WQAPC(L) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA8 = WQA8 + (WQFPLM*WQBMM(L) + WQFPLPM*WQPRM(L)) + & * WQVO(L,K,IDNOTRVA)* WQAPC(L)*WQAPCM + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA8X = (WQFPLX(nsp)*WQBMX(L,nsp) + WQFPLP*WQPRX(L,nsp)) + & * WQVOX(L,K,nsp) + WQA8 = WQA8 + WQA8X*WQAPC(L) + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR8 = (WQWDSL(L,K,8) + WQWPSL(L,K,8)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR8 = WQR8 + WQATML(L,KC,8) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,8) + DTWQ*WQR8 + DTWQO2*( WQA8 + & + WQF8*WQVO(L,K,8) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,8) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,8) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,8)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,8) + WQVO(L,K,8) = WQVO(L,K,8)+WQV(L,K,8) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,8)=WQVO(L,K,8) + WQVO(L,K,8) = WQVO(L,K,8)+WQV(L,K,8) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,8)=WQVO(L,K,8) + WQVO(L,K,8) = WQVO(L,K,8)+WQV(L,K,8) + ENDDO + ENDIF +C **** PARAM 09 + IF(ISTRWQ(9).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = 1.0 / (1.0 + DTWQO2*WQKDOP(L)) + WQA9C = (WQFPDC*WQBMC(L) + WQFPDP*WQPRC(L)) * WQVO(L,K,1) + WQA9D = (WQFPDD*WQBMD(L) + WQFPDP*WQPRD(L)) * WQVO(L,K,2) + WQA9G = (WQFPDG*WQBMG(L) + WQFPDP*WQPRG(L)) * WQVO(L,K,3) + WQA9 = (WQA9C+WQA9D+WQA9G) * WQAPC(L) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA9 = WQA9 + (WQFPDM*WQBMM(L) + WQFPDPM*WQPRM(L)) + & * WQVO(L,K,IDNOTRVA) * WQAPC(L)*WQAPCM + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA9X = (WQFPDX(nsp)*WQBMX(L,nsp) + WQFPDP*WQPRX(L,nsp)) + & * WQVOX(L,K,nsp) + WQA9 = WQA9 + WQA9X*WQAPC(L) + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR9 = (WQWDSL(L,K,9) + WQWPSL(L,K,9)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR9 = WQR9 + WQATML(L,KC,9) * VOLWQ(L) + ENDIF + WQRR(L)=WQVO(L,K,9)+DTWQ*WQR9+DTWQO2*(WQA9+WQKRPP(L)* + & WQVO(L,K,7)+WQKLPP(L)*WQVO(L,K,8)-WQKDOP(L)*WQVO(L,K,9)) + WQV(L,K,9)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,9) + WQVO(L,K,9) = WQVO(L,K,9)+WQV(L,K,9) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,9)=WQVO(L,K,9) + WQVO(L,K,9) = WQVO(L,K,9)+WQV(L,K,9) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,9)=WQVO(L,K,9) + WQVO(L,K,9) = WQVO(L,K,9)+WQV(L,K,9) + ENDDO + ENDIF +C **** PARAM 10 + IF(ISTRWQ(10).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQA10C=(WQFPIC*WQBMC(L)+WQFPIP*WQPRC(L)-WQPC(L)) + & *WQVO(L,K,1) + WQA10D=(WQFPID*WQBMD(L)+WQFPIP*WQPRD(L)-WQPD(L)) + & *WQVO(L,K,2) + WQA10G=(WQFPIG*WQBMG(L)+WQFPIP*WQPRG(L)-WQPG(L)) + & *WQVO(L,K,3) + WQKK(L) = (WQA10C+WQA10D+WQA10G) * WQAPC(L) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQKK(L) =WQKK(L)+(WQFPIM*WQBMM(L)+WQFPIP*WQPRM(L) + & -WQPM(L))*WQVO(L,K,IDNOTRVA) * WQAPC(L)*WQAPCM + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA10X=(WQFPIX(nsp)*WQBMX(L,nsp)+WQFPIP*WQPRX(L,nsp) + & -WQPX(L,nsp))*WQVOX(L,K,nsp) + WQKK(L) = WQKK(L) + WQA10X*WQAPC(L) + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,10)+WQWPSL(L,K,10)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,10) * VOLWQ(L) + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO +!} + IF(K.EQ.1)THEN +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFPO4D(L)*DZWQ(L) +C ENDDO + ENDIF +C DO L=2,LA +!} + WQRR(L) = WQVO(L,K,10) + DTWQ*WQRR(L) + DTWQO2*( WQKK(L) + & + WQKDOP(L)*WQVO(L,K,9) + WQH10(L)*WQVO(L,K,10) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQT10(L)*WQVO(L,K+1,10) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQT10(L)*WQVO(L,K+1,10) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQH10(L)) + WQV(L,K,10)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,10) + WQVO(L,K,10) = WQVO(L,K,10)+WQV(L,K,10) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,10)=WQVO(L,K,10) + WQVO(L,K,10) = WQVO(L,K,10)+WQV(L,K,10) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,10)=WQVO(L,K,10) + WQVO(L,K,10) = WQVO(L,K,10)+WQV(L,K,10) + ENDDO + ENDIF +C **** PARAM 11 + IF(ISTRWQ(11).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQI11 = - (WQKRPN(L)+WQRPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQI11) + WQA11C=(WQFNRC*WQBMC(L)+WQFNRP*WQPRC(L)) + & *WQANCC*WQVO(L,K,1) + WQA11D=(WQFNRD*WQBMD(L)+WQFNRP*WQPRD(L)) + & *WQANCD*WQVO(L,K,2) + WQA11G=(WQFNRG*WQBMG(L)+WQFNRP*WQPRG(L)) + & *WQANCG*WQVO(L,K,3) + WQA11 = WQA11C+WQA11D+WQA11G + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA11 =WQA11 + (WQFNRM*WQBMM(L)+WQFNRPM*WQPRM(L)) + & *WQANCM*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA11X=(WQFNRX(nsp)*WQBMX(L,nsp)+WQFNRP*WQPRX(L,nsp)) + & *WQANCX(nsp)*WQVOX(L,K,nsp) + WQA11 = WQA11+WQA11X + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR11 = (WQWDSL(L,K,11)+WQWPSL(L,K,11)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR11 = WQR11 + WQATML(L,KC,11) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,11) + DTWQ*WQR11 + DTWQO2*( WQA11 + & + WQI11*WQVO(L,K,11) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,11) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQRPSET(L,2)*WQVO(L,K+1,11) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,11)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,11) + WQVO(L,K,11) = WQVO(L,K,11)+WQV(L,K,11) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,11)=WQVO(L,K,11) + WQVO(L,K,11) = WQVO(L,K,11)+WQV(L,K,11) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,11)=WQVO(L,K,11) + WQVO(L,K,11) = WQVO(L,K,11)+WQV(L,K,11) + ENDDO + ENDIF +C **** PARAM 12 + IF(ISTRWQ(12).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQJ12 = - (WQKLPN(L)+WQLPSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQJ12) + WQA12C=(WQFNLC*WQBMC(L)+WQFNLP*WQPRC(L))*WQANCC + & *WQVO(L,K,1) + WQA12D=(WQFNLD*WQBMD(L)+WQFNLP*WQPRD(L))*WQANCD + & *WQVO(L,K,2) + WQA12G=(WQFNLG*WQBMG(L)+WQFNLP*WQPRG(L))*WQANCG + & *WQVO(L,K,3) + WQA12 = WQA12C+WQA12D+WQA12G + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA12 =WQA12 +(WQFNLM*WQBMM(L)+WQFNLPM*WQPRM(L)) + & *WQANCM*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA12X=(WQFNLX(nsp)*WQBMX(L,nsp)+WQFNLP*WQPRX(L,nsp)) + & *WQANCX(nsp)*WQVOX(L,K,nsp) + WQA12 = WQA12+WQA12X + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR12 = (WQWDSL(L,K,12)+WQWPSL(L,K,12)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR12 = WQR12 + WQATML(L,KC,12) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,12) + DTWQ*WQR12 + DTWQO2*( WQA12 + & + WQJ12*WQVO(L,K,12) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(K.NE.KC)THEN + WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,12) + ENDIF +C ENDDO +!} +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C IF(K.NE.KC)THEN +C DO L=2,LA +C WQRR(L) = WQRR(L) + DTWQO2*WQLPSET(L,2)*WQVO(L,K+1,12) +C ENDDO +C ENDIF + +C DO L=2,LA +!} + WQV(L,K,12)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L))*WQVO(L,K,12) + WQVO(L,K,12) = WQVO(L,K,12)+WQV(L,K,12) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,12)=WQVO(L,K,12) + WQVO(L,K,12) = WQVO(L,K,12)+WQV(L,K,12) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,12)=WQVO(L,K,12) + WQVO(L,K,12) = WQVO(L,K,12)+WQV(L,K,12) + ENDDO + ENDIF +C **** PARAM 13 + IF(ISTRWQ(13).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = 1.0 / (1.0 + DTWQO2*WQKDON(L)) + WQA13C=(WQFNDC*WQBMC(L)+WQFNDP*WQPRC(L))*WQANCC + & *WQVO(L,K,1) + WQA13D=(WQFNDD*WQBMD(L)+WQFNDP*WQPRD(L))*WQANCD + & *WQVO(L,K,2) + WQA13G=(WQFNDG*WQBMG(L)+WQFNDP*WQPRG(L))*WQANCG + & *WQVO(L,K,3) + WQA13 = WQA13C+WQA13D+WQA13G + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA13 =WQA13 + (WQFNDM*WQBMM(L)+WQFNDPM*WQPRM(L)) + & *WQANCM*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA13X=(WQFNDX(nsp)*WQBMX(L,nsp)+WQFNDP*WQPRX(L,nsp)) + & *WQANCX(nsp)*WQVOX(L,K,nsp) + WQA13 = WQA13+WQA13X + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR13 = (WQWDSL(L,K,13) + WQWPSL(L,K,13)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR13 = WQR13 + WQATML(L,KC,13) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,13) + DTWQ*WQR13 + DTWQO2*( WQA13 + & + WQKRPN(L)*WQVO(L,K,11) + WQKLPN(L)*WQVO(L,K,12) + & - WQKDON(L)*WQVO(L,K,13) ) + WQV(L,K,13)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,13) + WQVO(L,K,13) = WQVO(L,K,13)+WQV(L,K,13) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,13)=WQVO(L,K,13) + WQVO(L,K,13) = WQVO(L,K,13)+WQV(L,K,13) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,13)=WQVO(L,K,13) + WQVO(L,K,13) = WQVO(L,K,13)+WQV(L,K,13) + ENDDO + ENDIF +C **** PARAM 14 + IF(ISTRWQ(14).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,14)+WQWPSL(L,K,14)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,14) * VOLWQ(L) + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO +!} + IF(K.EQ.1)THEN +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFNH4(L)*DZWQ(L) +C ENDDO +!} + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C DO L=2,LA + WQKK(L) = 1.0 / (1.0 + DTWQO2*WQNIT(L)) + WQA14C=WQFNIC*WQBMC(L)+WQFNIP*WQPRC(L)-WQPNC(L)*WQPC(L) + WQA14D=WQFNID*WQBMD(L)+WQFNIP*WQPRD(L)-WQPND(L)*WQPD(L) + WQA14G=WQFNIG*WQBMG(L)+WQFNIP*WQPRG(L)-WQPNG(L)*WQPG(L) + WQA14 = WQA14C*WQANCC*WQVO(L,K,1) + & + WQA14D*WQANCD*WQVO(L,K,2) + WQA14G*WQANCG*WQVO(L,K,3) + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA14 = WQA14 + (WQFNIM*WQBMM(L)+WQFNIPM*WQPRM(L) + & - WQPNM(L)*WQPM(L))*WQANCM*WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA14X=WQFNIX(nsp)*WQBMX(L,nsp)+WQFNIP*WQPRX(L,nsp) + & -WQPNX(L,nsp)*WQPX(L,nsp) + WQA14 = WQA14 + WQA14X*WQANCX(nsp)*WQVOX(L,K,nsp) + enddo +!} GEOSR X-species : jgcho 2015.10.12 + WQRR(L) = WQVO(L,K,14) + DTWQ*WQRR(L) + DTWQO2*( WQA14 + & + WQKDON(L)*WQVO(L,K,13) - WQNIT(L)*WQVO(L,K,14) ) + WQV(L,K,14)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,14) + WQVO(L,K,14) = WQVO(L,K,14)+WQV(L,K,14) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,14)=WQVO(L,K,14) + WQVO(L,K,14) = WQVO(L,K,14)+WQV(L,K,14) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,14)=WQVO(L,K,14) + WQVO(L,K,14) = WQVO(L,K,14)+WQV(L,K,14) + ENDDO + ENDIF +C **** PARAM 15 + IF(ISTRWQ(15).EQ.1)THEN + DO L=LMPI2,LMPILA + IZ=IWQZMAP(L,K) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,15)+WQWPSL(L,K,15)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,15) * VOLWQ(L) + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO + IF(K.EQ.1)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFNO3(L)*DZWQ(L) +C ENDDO + ENDIF +C DO L=2,LA +!} + WQA15C = (WQPNC(L)-1.0)*WQPC(L) * WQANCC * WQVO(L,K,1) + WQA15D = (WQPND(L)-1.0)*WQPD(L) * WQANCD * WQVO(L,K,2) + WQA15G = (WQPNG(L)-1.0)*WQPG(L) * WQANCG * WQVO(L,K,3) + WQA15 = WQA15C+WQA15D+WQA15G + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQA15 =WQA15 + (WQPNM(L)-1.0)*WQPM(L)*WQANCM + & *WQVO(L,K,IDNOTRVA) + ENDIF +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQA15X=(WQPNX(L,nsp)-1.0)*WQPX(L,nsp) * WQANCX(nsp) + & * WQVOX(L,K,nsp) +! & * WQVO(L,K,nsp) + WQA15 = WQA15 + WQA15X + enddo +!} GEOSR X-species : jgcho 2015.10.12 + WQV(L,K,15)=SCB(L)*( WQVO(L,K,15) + DTWQ*WQRR(L) + & + DTWQO2*( WQA15 + & -WQANDC*WQDENIT(L)*WQVO(L,K,6)+WQNIT(L)*WQVO(L,K,14))) + & +(1.-SCB(L))*WQVO(L,K,15) + WQVO(L,K,15) = WQVO(L,K,15)+WQV(L,K,15) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,15)=WQVO(L,K,15) + WQVO(L,K,15) = WQVO(L,K,15)+WQV(L,K,15) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,15)=WQVO(L,K,15) + WQVO(L,K,15) = WQVO(L,K,15)+WQV(L,K,15) + ENDDO + ENDIF +C **** PARAM 16 + IF(ISTRWQ(16).EQ.1)THEN + IF(IWQSI.EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQM16 = - (WQKSUA(IWQT(L)) + WQBDSET(L,1)) + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQM16) + WQA16D = (WQFSPD*WQBMD(L) + WQFSPP*WQPRD(L)) * WQASCD + & * WQVO(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQA16D = WQA16D + (WQFSPDX(nsp)*WQBMX(L,nsp) + & + WQFSPPX(nsp)*WQPRX(L,nsp)) * WQASCDX(nsp) + & * WQVOX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR16 = (WQWDSL(L,K,16)+WQWPSL(L,K,16)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR16 = WQR16 + WQATML(L,KC,16) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,16) + DTWQ*WQR16 + DTWQO2*( WQA16D + & + WQM16*WQVO(L,K,16) ) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO + IF(K.NE.KC)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + DTWQO2*WQBDSET(L,2)*WQVO(L,K+1,16) +C ENDDO + ENDIF +C DO L=2,LA +!} + WQV(L,K,16)=SCB(L)*( WQRR(L)*WQKK(L) ) + & +(1.-SCB(L))*WQVO(L,K,16) + WQVO(L,K,16) = WQVO(L,K,16)+WQV(L,K,16) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,16)=WQVO(L,K,16) + WQVO(L,K,16) = WQVO(L,K,1)+WQV(L,K,16) + ENDIF + ENDDO +!} + ENDIF + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,16)=WQVO(L,K,16) + WQVO(L,K,16) = WQVO(L,K,16)+WQV(L,K,16) + ENDDO + ENDIF +C **** PARAM 17 + IF(ISTRWQ(17).EQ.1)THEN + IF(IWQSI.EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = (WQFSID*WQBMD(L) + WQFSIP*WQPRD(L) - WQPD(L)) + & * WQASCD * WQVO(L,K,2) +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + if (IWQX(nsp).eq.2) then + WQKK(L) = WQKK(L) + (WQFSIDX(nsp)*WQBMX(L,nsp) + & + WQFSIPX(nsp)*WQPRX(L,nsp) - WQPX(L,nsp)) + & * WQASCDX(nsp) * WQVOX(L,K,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,17)+WQWPSL(L,K,17)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,17) * VOLWQ(L) + ENDIF +C ENDDO + IF(K.EQ.1)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFSAD(L)*DZWQ(L) +C ENDDO + ENDIF +C DO L=2,LA + WQRR(L) = WQVO(L,K,17) + DTWQ*WQRR(L) + DTWQO2 + & *(WQKK(L)+WQKSUA(IWQT(L))*WQVO(L,K,16) + & +WQN17(L)*WQVO(L,K,17)) +C ENDDO + IF(K.NE.KC)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + DTWQO2*WQT17(L)*WQVO(L,K+1,17) +C ENDDO + ENDIF +C DO L=2,LA +!} + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQN17(L)) + WQV(L,K,17)=SCB(L)*( WQRR(L)*WQKK(L) ) + & +(1.-SCB(L))*WQVO(L,K,17) + WQVO(L,K,17) = WQVO(L,K,17)+WQV(L,K,17) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,17)=WQVO(L,K,17) + WQVO(L,K,17) = WQVO(L,K,17)+WQV(L,K,17) + ENDIF + ENDDO +!} + ENDIF + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,17)=WQVO(L,K,17) + WQVO(L,K,17) = WQVO(L,K,17)+WQV(L,K,17) + ENDDO + ENDIF +C **** PARAM 18 + IF(ISTRWQ(18).EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = 1.0 / (1.0 - WQO18(L)) +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,18)+WQWPSL(L,K,18)) * VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,18) * VOLWQ(L) + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO + IF(K.EQ.1)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFCOD(L)*DZWQ(L) +C ENDDO + ENDIF +C DO L=2,LA +!} + WQRR(L)=WQVO(L,K,18)+DTWQ*WQRR(L)+WQO18(L)*WQVO(L,K,18) + WQV(L,K,18)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,18) + WQVO(L,K,18) = WQVO(L,K,18)+WQV(L,K,18) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,18)=WQVO(L,K,18) + WQVO(L,K,18) = WQVO(L,K,18)+WQV(L,K,18) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,18)=WQVO(L,K,18) + WQVO(L,K,18) = WQVO(L,K,18)+WQV(L,K,18) + ENDDO + ENDIF +C **** PARAM 19 + IF(ISTRWQ(19).EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = 1.0 / (1.0 - DTWQO2*WQP19(L)) +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQRR(L) = (WQWDSL(L,K,19)+WQWPSL(L,K,19)) * VOLWQ(L) + XDOPSL(L,K) = XDOPSL(L,K) + WQRR(L)*DTWQ*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) + WQRR(L)*DTWQ*DZC(K)*HP(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQRR(L) = WQRR(L) + WQATML(L,KC,19) * VOLWQ(L) + ENDIF +!{GeoSR, YSSONG, WQ WET/DRY, 110915 +C ENDDO + IF(K.EQ.KC)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + WQKRDOS(L) +C ENDDO + ENDIF + IF(K.EQ.1)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + WQBFO2(L)*DZWQ(L) + XDOSOD(L,K) = XDOSOD(L,K) + WQBFO2(L)*DTWQ + XDOALL(L,K) = XDOALL(L,K) + WQBFO2(L)*DTWQ +C ENDDO + ENDIF +C DO L=2,LA +!} + IZ=IWQZMAP(L,K) + O2WQ(L) = MAX(WQVO(L,K,19), 0.0) + WQTTC = (1.3 - 0.3*WQPNC(L)) * WQPC(L) + WQTTD = (1.3 - 0.3*WQPND(L)) * WQPD(L) + WQTTG = (1.3 - 0.3*WQPNG(L)) * WQPG(L) + XDOPPB(L,K) = XDOPPB(L,K) + ( WQTTC*WQVO(L,K,1) + & +WQTTD*WQVO(L,K,2)+WQTTG*WQVO(L,K,3))*WQAOCR*DTWQO2 + & *DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) + ( WQTTC*WQVO(L,K,1) + & +WQTTD*WQVO(L,K,2)+WQTTG*WQVO(L,K,3))*WQAOCR*DTWQO2 + & *DZC(K)*HP(L) +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + WQTTX(nsp)=(1.3 - 0.3*WQPNX(L,nsp)) * WQPX(L,nsp) + XDOPPB(L,K) = XDOPPB(L,K) + ( WQTTX(nsp)*WQVOX(L,K,nsp)) + & *WQAOCR*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) + ( WQTTX(nsp)*WQVOX(L,K,nsp)) + & *WQAOCR*DTWQO2*DZC(K)*HP(L) + enddo +!} GEOSR X-species : jgcho 2015.10.12 + + XMRM = CFCDCWQ*O2WQ(L)*WQBMC(L)/(WQKHRC+O2WQ(L)+ 1.E-18) + WQA19C = WQTTC - XMRM + XDORRB(L,K) = XDORRB(L,K) - XMRM*WQVO(L,K,1) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) - XMRM*WQVO(L,K,1) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + + XMRM = CFCDDWQ*O2WQ(L)*WQBMD(L)/(WQKHRD+O2WQ(L)+ 1.E-18) + WQA19D = WQTTD - XMRM + XDORRB(L,K) = XDORRB(L,K) - XMRM*WQVO(L,K,2) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) - XMRM*WQVO(L,K,2) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + + XMRM = CFCDGWQ*O2WQ(L)*WQBMG(L)/(WQKHRG+O2WQ(L)+ 1.E-18) + WQA19G = WQTTG - XMRM + XDORRB(L,K) = XDORRB(L,K) - XMRM*WQVO(L,K,3) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) - XMRM*WQVO(L,K,3) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + + WQA19 = ( WQA19C*WQVO(L,K,1) + WQA19D*WQVO(L,K,2) + & + WQA19G*WQVO(L,K,3) ) * WQAOCR +!{ GEOSR X-species : jgcho 2015.10.12 + do nsp=1,NXSP + XMRM = CFCDWQX(nsp)*O2WQ(L)*WQBMX(L,nsp)/(WQKHRX(nsp) + & +O2WQ(L)+ 1.E-18) + WQA19X = WQTTX(nsp) - XMRM + XDORRB(L,K) = XDORRB(L,K) - XMRM*WQVOX(L,K,nsp) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) - XMRM*WQVOX(L,K,nsp) + & * WQAOCR*DTWQO2*DZC(K)*HP(L) + WQA19 = WQA19 + (WQA19X*WQVOX(L,K,nsp)) * WQAOCR + enddo +!} GEOSR X-species : jgcho 2015.10.12 +C +C MODIFIED BY MRM 05/23/99 TO ALLOW DIFFERENT AOCR CONSTANTS TO BE APPLI +C TO PHOTOSYNTHESIS AND RESPIRATION TERMS FOR MACROALGAE: +C + IF(IDNOTRVA.GT.0.AND.K.EQ.1)THEN + WQTTM = (1.3 - 0.3*WQPNM(L)) * WQPM(L) + XMRM=(1.0-WQFCDM)*O2WQ(L)*WQBMM(L)/(WQKHRM(IZ)+O2WQ(L) + & +1.E-18) + WQA19A = WQTTM * WQVO(L,K,IDNOTRVA) * WQAOCRPM - + & XMRM * WQVO(L,K,IDNOTRVA) * WQAOCRRM + WQA19 = WQA19 + WQA19A + XDOPPM(L,K) = XDOPPM(L,K) + + & WQTTM*WQVO(L,K,IDNOTRVA)*WQAOCRPM*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) + + & WQTTM*WQVO(L,K,IDNOTRVA)*WQAOCRPM*DTWQO2*DZC(K)*HP(L) + XDORRM(L,K) = XDORRM(L,K) - + & XMRM*WQVO(L,K,IDNOTRVA)*WQAOCRRM*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) - + & XMRM*WQVO(L,K,IDNOTRVA)*WQAOCRRM*DTWQO2*DZC(K)*HP(L) + ENDIF + WQRR(L) = WQVO(L,K,19) + DTWQ*WQRR(L) + DTWQO2*( WQA19 + & -WQAOCR*WQKHR(L)*WQVO(L,K,6)-WQAONT*WQNIT(L)*WQVO(L,K,14) + & + WQP19(L)*WQVO(L,K,19) ) + WQO18(L)*WQVO(L,K,18) + WQV(L,K,19)=SCB(L)*(WQRR(L)*WQKK(L))+(1.-SCB(L)) + & *WQVO(L,K,19) + WQV(L,K,19) = MAX (WQV(L,K,19), 0.0) + WQVO(L,K,19) = WQVO(L,K,19)+WQV(L,K,19) +C +C COMPUTE AND SAVE D.O. DEFICIT: +C + XMRM = WQDOS(L) - WQV(L,K,19) + XDODEF(L,K) = XDODEF(L,K) + XMRM*DTWQ*DZC(K)*HP(L) + IF(K.EQ.KC)THEN + XDOKAR(L,K) = XDOKAR(L,K) + WQKRDOS(L)*DTWQ*DZC(K)*HP(L) + & + WQP19(L)*WQVO(L,K,19)*DTWQO2*DZC(K)*HP(L) + XDOALL(L,K) = XDOALL(L,K) + WQKRDOS(L)*DTWQ*DZC(K)*HP(L) + & + WQP19(L)*WQVO(L,K,19)*DTWQO2*DZC(K)*HP(L) + ENDIF + XDODOC(L,K)=XDODOC(L,K) - WQAOCR*WQKHR(L)*WQVO(L,K,6) + & *DTWQO2*DZC(K)*HP(L) + XDOALL(L,K)=XDOALL(L,K) - WQAOCR*WQKHR(L)*WQVO(L,K,6) + & *DTWQO2*DZC(K)*HP(L) + XDONIT(L,K)=XDONIT(L,K)-WQAONT*WQNIT(L)*WQVO(L,K,14) + & *DTWQO2*DZC(K)*HP(L) + XDOALL(L,K)=XDOALL(L,K)-WQAONT*WQNIT(L)*WQVO(L,K,14) + & *DTWQO2*DZC(K)*HP(L) + XDOCOD(L,K)=XDOCOD(L,K) - WQO18(L)*WQVO(L,K,18) + & *DZC(K)*HP(L) + XDOALL(L,K)=XDOALL(L,K) - WQO18(L)*WQVO(L,K,18) + & *DZC(K)*HP(L) + XDODZ(L,K) = XDODZ(L,K) + DZC(K)*HP(L) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,19)=WQVO(L,K,19) + WQVO(L,K,19) = WQVO(L,K,19)+WQV(L,K,19) + ENDIF + ENDDO +!} + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,19)=WQVO(L,K,19) + WQVO(L,K,19) = WQVO(L,K,19)+WQV(L,K,19) + ENDDO + ENDIF +C **** PARAM 20 + IF(ISTRWQ(20).EQ.1)THEN + IF(IWQSRP.EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQT20 = - DTWQO2*WQWSSET(L,1) + WQKK(L) = 1.0 / (1.0 - WQT20) + WQRR(L)=WQVO(L,K,20)+DTWQ*WQR20(L)+WQT20*WQVO(L,K,20) +C ENDDO + IF(K.NE.KC)THEN +C DO L=2,LA + WQRR(L) = WQRR(L) + DTWQO2*WQWSSET(L,2)*WQVO(L,K+1,20) +C ENDDO + ENDIF +C DO L=2,LA + WQV(L,K,20)=SCB(L)*( WQRR(L)*WQKK(L) ) + & +(1.-SCB(L))*WQVO(L,K,20) + WQVO(L,K,20) = WQVO(L,K,20)+WQV(L,K,20) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,20)=WQVO(L,K,20) + WQVO(L,K,20) = WQVO(L,K,20)+WQV(L,K,20) + ENDIF + ENDDO +!} + ENDIF + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,20)=WQVO(L,K,20) + WQVO(L,K,20) = WQVO(L,K,20)+WQV(L,K,20) + ENDDO + ENDIF +C +C WQTD1FCB=1+DTWQO2*WQS21,WQTD2FCB=1/(1-DTWQO2*S21) +C +C **** PARAM 21 + IF(ISTRWQ(21).EQ.1)THEN + IF(IWQFCB.EQ.1)THEN + DO L=LMPI2,LMPILA +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN +!} + WQKK(L) = WQTD2FCB(IWQT(L)) +C +C DEFINITIONS ATM DRY DEP LOADS VOLUMN +C + WQR21= (WQWDSL(L,K,NWQV)+WQWPSL(L,K,NWQV))*VOLWQ(L) + IF(K.EQ.KC)THEN +C +C DEFINITIONS ATM WET DEP VOLUMN +C + WQR21 = WQR21 + WQATML(L,KC,21) * VOLWQ(L) + ENDIF + WQRR(L) = WQVO(L,K,NWQV)*WQTD1FCB(IWQT(L)) + DTWQ*WQR21 + WQV(L,K,21)=SCB(L)*( WQRR(L)*WQKK(L) ) + & +(1.-SCB(L))*WQVO(L,K,21) + WQVO(L,K,21) = WQVO(L,K,21)+WQV(L,K,21) +!{GeoSR, YSSONG, WQ WET/DRY, 110915 + ELSE + WQV(L,K,21)=WQVO(L,K,21) + WQVO(L,K,21) = WQVO(L,K,21)+WQV(L,K,21) + ENDIF + ENDDO +!} + ENDIF + ELSE + DO L=LMPI2,LMPILA + WQV(L,K,21)=WQVO(L,K,21) + WQVO(L,K,21) = WQVO(L,K,21)+WQV(L,K,21) + ENDDO + ENDIF + +!{GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 + IF(IWQTS.GE.1)THEN + IF(ISCOMP .EQ. 3. OR. ISCOMP .EQ. 4)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + TIME=TIME/TCON + IF(MYRANK.EQ.0)THEN + WRITE(FLN,"('WQRTS',I2.2,'.DAT')") K + OPEN(300+K,FILE=FLN,POSITION='APPEND') + DO M=1,IWQTS + LL=LWQTS(M) + WRITE(300+K,8999) TIME,WQPC(LL),WQBMC(LL),WQPRC(LL), + & WQPD(LL),WQBMD(LL),WQPRD(LL),WQPG(LL),WQBMG(LL),WQPRG(LL) + ENDDO + CLOSE(300+K) + ENDIF + ENDIF + ENDIF +!}GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 + + ENDDO +C + IF(.FALSE.)THEN + DO NSP=1,21; call collect_in_zero_array(WQV(:,:,NSP)); ENDDO !#1-1 + IF(MYRANK.EQ.0) THEN + DO LWQ3K=1,21 + DO K=1,KC + PRINT*,'WQ2V=',LWQ3K,k,sum(abs(dble(WQV(:,K,LWQ3K)))) + ENDDO + ENDDO + PRINT*,'L3184=',WQV(3184,2,1) + ENDIF + ENDIF +C +C ---------------------------------------------------------------- +C +C INCREMENT COUNTER FOR LIMITATION AND XDOXXX DO COMPONENT ARRAYS: +C + IF(ISDYNSTP.EQ.0)THEN + TIMTMP=DT*FLOAT(N)+TCON*TBEGIN + TIMTMP=TIMTMP/TCTMSR + ELSE + TIMTMP=TIMESEC/TCTMSR + ENDIF + TIMESUM3 = TIMESUM3 + TIMTMP + NLIM = NLIM + 1 +C +C COMPUTE WQCHL,WQTAMP,WQPO4D,WQSAD AT A NEW TIME STEP: WQCHLX=1/WQCHLX +C + DO K=1,KC + DO L=LMPI2,LMPILA + WQCHL(L,K) = WQV(L,K,1)*WQCHLC + WQV(L,K,2)*WQCHLD + & + WQV(L,K,3)*WQCHLG +!{ GEOSR X-species : jgcho 2015.10.13 + do nsp=1,NXSP + WQCHL(L,K) = WQCHL(L,K) + WQVX(L,K,nsp)*WQCHLX(nsp) + enddo +!} GEOSR X-species : jgcho 2015.10.13 + ENDDO + ENDDO +C + IF(IWQSRP.EQ.1)THEN + DO K=1,KC + DO L=LMPI2,LMPILA + O2WQ(L) = MAX(WQV(L,K,19), 0.0) + WQTAMD = MIN( WQTAMDMX*EXP(-WQKDOTAM*O2WQ(L)), WQV(L,K,20) ) + WQTAMP(L,K) = WQV(L,K,20) - WQTAMD + WQPO4D(L,K) = WQV(L,K,10) / (1.0 + WQKPO4P*WQTAMP(L,K)) + WQSAD(L,K) = WQV(L,K,17) / (1.0 + WQKSAP*WQTAMP(L,K)) + ENDDO + ENDDO + ELSE IF(IWQSRP.EQ.2)THEN + DO K=1,KC + DO L=LMPI2,LMPILA + WQPO4D(L,K) = WQV(L,K,10) / (1.0 + WQKPO4P*SEDT(L,K)) + WQSAD(L,K) = WQV(L,K,17) / (1.0 + WQKSAP*SEDT(L,K)) + ENDDO + ENDDO + ELSE + DO K=1,KC + DO L=LMPI2,LMPILA + WQPO4D(L,K) = WQV(L,K,10) + WQSAD(L,K) = WQV(L,K,17) + ENDDO + ENDDO + ENDIF +C +C COUPLING TO SEDIMENT MODEL +C: EVALUATE DEP. FLUX USING NEW VALUES CAUSE IMPLICIT SCHEME IS USED IN +C SPM +C + IF(IWQBEN.EQ.0)THEN + DO L=LMPI2,LMPILA + IMWQZ = IWQZMAP(L,1) + WQDFBC(L) = SCB(L)*WQWSC(IMWQZ)*WQV(L,1,1) + WQDFBD(L) = SCB(L)*WQWSD(IMWQZ)*WQV(L,1,2) + WQDFBG(L) = SCB(L)*WQWSG(IMWQZ)*WQV(L,1,3) + & +WQWSM*DZWQ(L)*WQV(L,1,IDNOTRVA) +!{ GEOSR X-species : jgcho 2015.10.13 WQWSX(1,i) + do nsp=1,NXSP + if (IWQX(nsp).eq.1) then + WQDFBC(L) = WQDFBC(L) + & + SCB(L)*WQWSX(IMWQZ,nsp)*WQVX(L,1,nsp) + endif + if (IWQX(nsp).eq.2) then + WQDFBD(L) = WQDFBD(L) + & + SCB(L)*WQWSX(IMWQZ,nsp)*WQVX(L,1,nsp) + endif + if (IWQX(nsp).eq.3) then + WQDFBG(L) = WQDFBG(L) + & + SCB(L)*WQWSX(IMWQZ,nsp)*WQVX(L,1,nsp) + endif + enddo +!} GEOSR X-species : jgcho 2015.10.13 + WQDFRC(L) = SCB(L)*WQWSRP(IMWQZ)*WQV(L,1,4) + WQDFLC(L) = SCB(L)*WQWSLP(IMWQZ)*WQV(L,1,5) + WQDFRP(L) = SCB(L)*WQWSRP(IMWQZ)*WQV(L,1,7) + WQDFLP(L) = SCB(L)*WQWSLP(IMWQZ)*WQV(L,1,8) + WQDFRN(L) = SCB(L)*WQWSRP(IMWQZ)*WQV(L,1,11) + WQDFLN(L) = SCB(L)*WQWSLP(IMWQZ)*WQV(L,1,12) + IF(IWQSI.EQ.1) WQDFSI(L) = SCB(L)*WQWSD(IMWQZ)*WQV(L,1,16) + ENDDO + IF(IWQSRP.EQ.1)THEN + DO L=LMPI2,LMPILA + IMWQZ = IWQZMAP(L,1) + WQDFLP(L) = SCB(L)*( WQDFLP(L) + & + WQWSS(IMWQZ)*( WQV(L,1,10)-WQPO4D(L,1) ) ) + IF(IWQSI.EQ.1) WQDFSI(L) = SCB(L)*( WQDFSI(L) + & + WQWSS(IMWQZ)*( WQV(L,1,17)-WQSAD(L,1) ) ) + ENDDO + ELSE IF(IWQSRP.EQ.2)THEN + DO L=LMPI2,LMPILA + WQDFLP(L) = SCB(L)*( WQDFLP(L)+WSEDO(NS)*( WQV(L,1,10) + & -WQPO4D(L,1) ) ) + IF(IWQSI.EQ.1) WQDFSI(L) = SCB(L)*( WQDFSI(L) + & + WSEDO(NS)*( WQV(L,1,17)-WQSAD(L,1) ) ) + ENDDO + ENDIF + ENDIF +C +C DIURNAL DO ANALYSIS +C + IF(NDDOAVG.GE.1)THEN + IF(MYRANK.EQ.0) OPEN(1,FILE='DIURNDO.OUT',POSITION='APPEND') + NDDOCNT=NDDOCNT+1 + NSTPTMP=NDDOAVG*NTSPTC/2 + RMULTMP=1./FLOAT(NSTPTMP) + DO K=1,KC + DO L=2,LA + DDOMAX(L,K)=MAX(DDOMAX(L,K),WQV(L,K,19)) + DDOMIN(L,K)=MIN(DDOMIN(L,K),WQV(L,K,19)) + ENDDO + ENDDO + IF(NDDOCNT.EQ.NSTPTMP)THEN + NDDOCNT=0 + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + TIME=TIME/TCON + ELSE + TIME=TIMESEC/TCON + ENDIF + IF(MYRANK.EQ.0)THEN + WRITE(1,1111)N,TIME + DO L=2,LA + WRITE(1,1112)IL(L),JL(L),(DDOMIN(L,K),K=1,KC), + & (DDOMAX(L,K),K=1,KC) + ENDDO + ENDIF + DO K=1,KC + DO L=2,LA + DDOMAX(L,K)=-1.E6 + DDOMIN(L,K)=1.E6 + ENDDO + ENDDO + ENDIF + IF(MYRANK.EQ.0) CLOSE(1) + ENDIF +C +C LIGHT EXTINCTION ANALYSIS +C + IF(NDLTAVG.GE.1)THEN + IF(MYRANK.EQ.0) OPEN(1,FILE='LIGHT.OUT',POSITION='APPEND') + NDLTCNT=NDLTCNT+1 + NSTPTMP=NDLTAVG*NTSPTC/2 + RMULTMP=1./FLOAT(NSTPTMP) + DO K=1,KC + DO L=2,LA + RLIGHT1=WQKEB(IMWQZT(L))+WQKETSS*SEDT(L,K) + XMRM = WQKECHL*WQCHL(L,K) + IF(WQKECHL .LT. 0.0)THEN + XMRM = 0.054*WQCHL(L,K)**0.6667 + 0.0088*WQCHL(L,K) + ENDIF + RLIGHT2 = XMRM + RLIGHTT(L,K)=RLIGHTT(L,K)+RLIGHT1 + RLIGHTC(L,K)=RLIGHTC(L,K)+RLIGHT1+RLIGHT2 + ENDDO + ENDDO + IF(NDLTCNT.EQ.NSTPTMP)THEN + NDLTCNT=0 + IF(ISDYNSTP.EQ.0)THEN + TIME=DT*FLOAT(N)+TCON*TBEGIN + TIME=TIME/TCON + ELSE + TIME=TIMESEC/TCON + ENDIF + DO K=1,KC + DO L=2,LA + RLIGHTT(L,K)=RMULTMP*RLIGHTT(L,K) + RLIGHTC(L,K)=RMULTMP*RLIGHTC(L,K) + ENDDO + ENDDO + IF(MYRANK.EQ.0)THEN + WRITE(1,1111)N,TIME + DO L=2,LA + WRITE(1,1113)IL(L),JL(L),(RLIGHTT(L,K),K=1,KC), + & (RLIGHTC(L,K),K=1,KC) + ENDDO + ENDIF + DO K=1,KC + DO L=2,LA + RLIGHTT(L,K)=0. + RLIGHTC(L,K)=0. + ENDDO + ENDDO + ENDIF + IF(MYRANK.EQ.0) CLOSE(1) + ENDIF +!{ GEOSR STOKES : YSSONG 2015.08.18 + do nsp=1,NXSP + DO K=1,KC + DO L=LMPI2,LMPILA + WQVOXB(L,K,nsp) = WQVOX(L,K,nsp) + ENDDO + ENDDO + enddo + + DO K=1,KC + DO L=LMPI2,LMPILA + WQVOCB(L,K) = WQVO(L,K,1) + ENDDO + ENDDO +C + if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + IF(ISSTOKEX(1).EQ.1)THEN + IF(MYRANK.EQ.0)THEN + do i=1,IWQTS + WRITE(FLN,"('STOKE',I2.2,'.OUT')") i + OPEN(1,FILE=trim(FLN),POSITION='APPEND') ! VERTICAL VELOCITY, ALGAL-DENSITY, SOLAR RADIATION, chl-a PRINT AT EACH LAYER + WRITE(FMTSTR, '("(F12.6,",I0,"(E12.4))")') NXSP*KC*4 + write(1,FMTSTR) TIMTMP + & ,((WQALSETX(LWQTS(i),k,nsp),nsp=1,NXSP),k=kc,1,-1) + & ,((WQRHOX(LWQTS(i),k,nsp),nsp=1,NXSP),k=kc,1,-1) + & ,((WQSOLDAX(LWQTS(i),k,nsp),nsp=1,NXSP),k=kc,1,-1) + & ,(WQCHL(LWQTS(i),k),k=kc,1,-1) + close(1) + enddo +! OPEN(1,FILE='STOKE.OUT',POSITION='APPEND') +! WRITE(1,1114) TIMTMP,(WQALSETX(136,K,1),WQRHOX(136,K,1), ! GEOSR X-species : jgcho 2015.10.13 +! & WQSOLDAX(136,K,1),WQCHL(136,K),K=1,KC) +! CLOSE(1) + ENDIF + ENDIF + endif !if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 +!} GEOSR STOKES : YSSONG 2015.08.18 +!{ GeoSR Bentic-cyano : JHLEE 2015.10.12 +C SETTLING VELOCITY ANALYSIS +! IF(ISCYANO.GE.1)THEN +! OPEN(1,FILE='CYANO.OUT',POSITION='APPEND') +! WRITE(1,1115) TIMTMP,CYA_ADD(136),CYA_TIME(136) +! CLOSE(1) +! ENDIF +! 1115 FORMAT(F12.6,2(F15.6,1x)) +!} GeoSR Bentic-cyano : JHLEE 2015.10.12 + 1111 FORMAT(I12,F10.4) + 1112 FORMAT(2I5,12F7.2) + 1113 FORMAT(2I5,12E12.4) + 8999 FORMAT(F10.5,9E12.4) + + RETURN + END From c0bbc7b238086bc5b464678849fa6b3bafbbdf80 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 13:52:17 +0100 Subject: [PATCH 22/77] Add the MPI module contained in MPI.f90 --- .../original_efdc_files/MPI.f90 | 712 ++++++++++++++++++ 1 file changed, 712 insertions(+) create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 new file mode 100644 index 000000000..a870092d5 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 @@ -0,0 +1,712 @@ + MODULE MPI + + USE GLOBAL + USE OMP_LIB + INCLUDE 'mpif.h' + + REAL*8 :: STIME,TTIME,MPI_WTIMES(4000) + REAL*8 :: S1TIME,S2TIME,S3TIME,S4TIME,S5TIME + CHARACTER*30 :: MPI_HOSTSPOTS(4000),WT_CHAR + CHARACTER*3 :: WT_NUM + PARAMETER (MAXNTH=64) + INTEGER RECVCOUNTS(0:1000),DISPLS(0:1000) + INTEGER ITHE,LOMPS,LOMPE,LOMPS1,LOMPE1,NCOLLECT + INTEGER IERR,MYRANK,NPROCS,OMP_OPT + INTEGER IOMPS(MAXNTH),IOMPE(MAXNTH),IOMPS1(MAXNTH),IOMPE1(MAXNTH) + INTEGER NTH,OMPNUM,LSTART,LEND + INTEGER INEWTYPE,NEWTYPE(1000),INEWTYPE1(0:1000),INEWTYPE2(0:1000),INEWTYPE3(0:1000) + INTEGER NDRYCELL,OMPTHPUV,OMPTHCONG + INTEGER IREQ(1000),IREQ1,IREQ2,NUMBER, LCHUNK + INTEGER STATUS1(MPI_STATUS_SIZE),STATUS2(MPI_STATUS_SIZE) + INTEGER LMPI1,LMPI2,LMPILA,LMPILC + INTEGER WT_VAL,WT_COUNT,WT_RATIO + INTEGER,ALLOCATABLE :: MPI_IMASKDRY(:) + CHARACTER MPI_DEBUG_C + INTEGER MPI_DEBUG + INTEGER MPI_I4 + REAL MPI_R4 + REAL*8 MPI_R8 + LOGICAL MPI_LG + LOGICAL IS_PSER(10000),IS_CSER(10000,1000),IS_QSER(10000),IS_QCTL(10000) + + CONTAINS + +!########################################################################################################### + + SUBROUTINE MPI_INITIALIZE + + USE OMP_LIB + INCLUDE 'mpif.h' + MYRANK=0 + CALL MPI_INIT(IERR) + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR) + CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) + +!$OMP PARALLEL + OMPNUM=OMP_GET_NUM_THREADS() + CALL OMP_SET_NUM_THREADS(OMPNUM) +!$OMP END PARALLEL + + CALL GETARG(2,MPI_DEBUG_C) + READ(MPI_DEBUG_C,'(I1.1)') MPI_DEBUG + IF(MYRANK.EQ.0) PRINT*, 'MPI_DEBUG = ', MPI_DEBUG + + ENDSUBROUTINE MPI_INITIALIZE + +!########################################################################################################### + + SUBROUTINE MPI_DECOMPOSITION + + USE OMP_LIB + INCLUDE 'mpif.h' + + IF(MYRANK==0) WRITE(*,*) '#########################' + IF(MYRANK==0) WRITE(*,*) 'MPI NODDS =',NPROCS + IF(MYRANK==0) WRITE(*,*) 'OMP THREADS =',OMPNUM + IF(MYRANK==0) WRITE(*,*) '#########################' + + NTH = OMPNUM * NPROCS + LCHUNK=NINT(FLOAT(LC-1)/FLOAT(NTH)) + + DO N=1,NTH + IOMPS(N)=(N-1)*LCHUNK+2 + IOMPE(N)=IOMPS(N)+LCHUNK -1 + ENDDO + IOMPE(NTH)=LC + IOMPS1=IOMPS ; IOMPE1=IOMPE + IOMPS1(1)=1 ; IOMPE1(NTH)=LA + + LMPI1 = IOMPS1(OMPNUM*MYRANK+1) + LMPI2 = IOMPS(OMPNUM*MYRANK+1) + LMPILC = IOMPE(OMPNUM*MYRANK+OMPNUM) + LMPILA = IOMPE1(OMPNUM*MYRANK+OMPNUM) + + IF(MYRANK==0) THEN + PRINT*, '####################################################' + DO N=0,NPROCS-1 + PRINT*, 'RANK NUMBER : ', N , IOMPS(OMPNUM*N+1), IOMPE(OMPNUM*N+OMPNUM) + ENDDO + PRINT*, '####################################################' + + PRINT*, '####################################################' + DO N=0,NPROCS-1 + PRINT*, 'RANK NUMBER : ', N , IOMPS1(OMPNUM*N+1), IOMPE1(OMPNUM*N+OMPNUM) + ENDDO + PRINT*, '####################################################' + ENDIF + + DO N=0,NPROCS-1 + RECVCOUNTS(N)=IOMPE(OMPNUM*(N+1))-IOMPS(OMPNUM*N+1)+1 + ENDDO + + DISPLS(0)=2 + DO N=1,NPROCS-1 + DISPLS(N)=DISPLS(N-1)+RECVCOUNTS(N-1) + ENDDO + + CALL MPI_TYPE_VECTOR(KCM,IC,LCM,MPI_REAL,INEWTYPE,IERR) + CALL MPI_TYPE_COMMIT(INEWTYPE,IERR) + + DO N=0,NPROCS-1 + CALL MPI_TYPE_VECTOR(KCM,RECVCOUNTS(N),LCM,MPI_REAL,INEWTYPE1(N),IERR) + CALL MPI_TYPE_COMMIT(INEWTYPE1(N),IERR) + ENDDO + + DO N=0,NPROCS-1 + CALL MPI_TYPE_VECTOR(KBM,RECVCOUNTS(N),LCM,MPI_REAL,INEWTYPE2(N),IERR) + CALL MPI_TYPE_COMMIT(INEWTYPE2(N),IERR) + ENDDO + + DO N=0,NPROCS-1 + CALL MPI_TYPE_VECTOR(KCM+1,RECVCOUNTS(N),LCM,MPI_REAL,INEWTYPE3(N),IERR) + CALL MPI_TYPE_COMMIT(INEWTYPE3(N),IERR) + ENDDO + + ENDSUBROUTINE MPI_DECOMPOSITION + +!########################################################################################################### + + SUBROUTINE BROADCAST_BOUNDARY(ARRAY_1D,NUMBER) + + INCLUDE 'mpif.h' + REAL ARRAY_1D(LCM) + + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR) + CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + IF(NPROCS.GE.3)THEN + DO NP=2,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE BROADCAST_BOUNDARY_LBM(ARRAY_1D,NUMBER) + + INCLUDE 'mpif.h' + REAL ARRAY_1D(0:LCM) + + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR) + CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + IF(NPROCS.GE.3)THEN + DO NP=2,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_REAL,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_REAL,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE BROADCAST_BOUNDARY_R8(ARRAY_1D,NUMBER) + + INCLUDE 'mpif.h' + REAL*8 ARRAY_1D(LCM) + + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR) + CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_DOUBLE,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_DOUBLE,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_DOUBLE,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_DOUBLE,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + IF(NPROCS.GE.3)THEN + DO NP=2,NPROCS-1,2 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_DOUBLE,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_DOUBLE,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_1D(IOMPS(OMPNUM*NP+1)) ,NUMBER,MPI_DOUBLE,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_1D(IOMPS(OMPNUM*NP+1)-NUMBER),NUMBER,MPI_DOUBLE,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE BROADCAST_BOUNDARY_ARRAY(ARRAY_2D,NUMBER) + + INCLUDE 'mpif.h' + REAL ARRAY_2D(LCM,KCM) + + IF(NPROCS.GT.1)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_2D(IOMPS(OMPNUM*NP+1)-NUMBER,1),1,INEWTYPE,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_2D(IOMPS(OMPNUM*NP+1),1) ,1,INEWTYPE,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_2D(IOMPS(OMPNUM*NP+1),1) ,1,INEWTYPE,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_2D(IOMPS(OMPNUM*NP+1)-NUMBER,1),1,INEWTYPE,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE BROADCAST_BOUNDARY_ARRAY_ZEROKCM(ARRAY_2D,NUMBER) + + INCLUDE 'mpif.h' + REAL ARRAY_2D(LCM,0:KCM) + + IF(NPROCS.GT.1)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP-1)THEN + CALL MPI_ISEND( ARRAY_2D(IOMPS(OMPNUM*NP+1)-NUMBER,0),1,INEWTYPE3,NP,87,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_2D(IOMPS(OMPNUM*NP+1),0) ,1,INEWTYPE3,NP,82,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ELSEIF(MYRANK==NP)THEN + CALL MPI_ISEND( ARRAY_2D(IOMPS(OMPNUM*NP+1),0) ,1,INEWTYPE3,NP-1,82,MPI_COMM_WORLD,IREQ1,IERR) + CALL MPI_IRECV( ARRAY_2D(IOMPS(OMPNUM*NP+1)-NUMBER,0),1,INEWTYPE3,NP-1,87,MPI_COMM_WORLD,IREQ2,IERR) + CALL MPI_WAIT(IREQ1,STATUS1,IERR) + CALL MPI_WAIT(IREQ2,STATUS2,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO(ARRAY_1D) + + INCLUDE 'mpif.h' + REAL ARRAY_1D(LCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_REAL,0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_R8(ARRAY_1D) + + INCLUDE 'mpif.h' + REAL*8 ARRAY_1D(LCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_DOUBLE,0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_DOUBLE,NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_INT(ARRAY_1D) + + INCLUDE 'mpif.h' + INTEGER ARRAY_1D(LCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_INTEGER,0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_INTEGER,NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_LBM(ARRAY_1D) + + INCLUDE 'mpif.h' + REAL ARRAY_1D(0:LCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_REAL,0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_1D(DISPLS(NP)),RECVCOUNTS(NP),MPI_REAL,NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_ARRAY(ARRAY_2D) + + INCLUDE 'mpif.h' + REAL ARRAY_2D(LCM,KCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_2D(DISPLS(NP),1),1,INEWTYPE1(NP),0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_2D(DISPLS(NP),1),1,INEWTYPE1(NP),NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_ARRAY_KBM(ARRAY_2D) + + INCLUDE 'mpif.h' + REAL ARRAY_2D(LCM,KBM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_2D(DISPLS(NP),1),1,INEWTYPE2(NP),0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_2D(DISPLS(NP),1),1,INEWTYPE2(NP),NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + SUBROUTINE COLLECT_IN_ZERO_ARRAY_0KCM(ARRAY_2D) + + INCLUDE 'mpif.h' + REAL ARRAY_2D(LCM,0:KCM) + + IF(NPROCS.GE.2)THEN + DO NP=1,NPROCS-1 + IF(MYRANK==NP) THEN + CALL MPI_ISEND( ARRAY_2D(DISPLS(NP),0),1,INEWTYPE2(NP),0,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ELSEIF(MYRANK==0) THEN + CALL MPI_IRECV( ARRAY_2D(DISPLS(NP),0),1,INEWTYPE2(NP),NP,87,MPI_COMM_WORLD,IREQ(NP),IERR) + CALL MPI_WAIT(IREQ(NP),STATUS1,IERR) + ENDIF + ENDDO + ENDIF + END SUBROUTINE + +!########################################################################################################### + + REAL*8 FUNCTION MPI_TIC() + + INCLUDE 'mpif.h' + + MPI_TIC=MPI_WTIME() + + END FUNCTION + +!########################################################################################################### + + REAL*8 FUNCTION MPI_TOC(TMPTIME) + + INCLUDE 'mpif.h' + REAL*8 TMPTIME + + MPI_TOC=MPI_WTIME()-TMPTIME + + END FUNCTION + +!########################################################################################################### + + SUBROUTINE MPI_WTIME_PRINT(WT_CHAR,WT_RATIO,WT_VAL,WT_COUNT) + + CHARACTER(LEN=*) WT_CHAR + INTEGER WT_VAL, WT_COUNT, WT_RATIO + + PRINT*,TRIM(WT_CHAR) + DO II=1,WT_COUNT + WRITE(WT_NUM,'(I3.3)') II + MPI_HOSTSPOTS(WT_VAL+ii)=' '//TRIM(WT_CHAR)//'_LOOP_'//WT_NUM + IF(REAL(MPI_WTIMES(WT_VAL+II)).GE.0.002)THEN + WRITE(*,'(I5,A20,F10.3)') WT_VAL+II, MPI_HOSTSPOTS(WT_VAL+II), & + WT_RATIO*REAL(MPI_WTIMES(WT_VAL+II)) + ENDIF + ENDDO + WRITE(*,'(A20,F10.3)') ' '//TRIM(WT_CHAR)//'_TOTAL', & + WT_RATIO*REAL(SUM(MPI_WTIMES((WT_VAL+1):(WT_VAL+WT_COUNT)))) + + END SUBROUTINE + +!########################################################################################################### + + LOGICAL FUNCTION ISDOMAIN(LDOMAIN) + + INTEGER LDOMAIN + + IF(LDOMAIN.GE.LMPI1.AND.LDOMAIN.LE.LMPILA)THEN + ISDOMAIN=.TRUE. + ELSE + ISDOMAIN=.FALSE. + ENDIF + + END FUNCTION + +!########################################################################################################### + + SUBROUTINE ISINPUTS(IS_PSER,IS_CSER,IS_QSER,IS_QCTL) + + LOGICAL IS_PSER(10000),IS_CSER(10000,1000),IS_QSER(10000),IS_QCTL(10000) + + IS_PSER=.TRUE. !.FALSE. + IS_CSER=.TRUE. !.FALSE. + IS_QSER=.TRUE. !.FALSE. + IS_QCTL=.TRUE. !.FALSE. + + IF(.FALSE.)THEN ! NOT USED + IF(NPSER.GT.0)THEN +!! CARD C18 + DO II=1,NPBS + IF(ISDOMAIN(LIJ(IPBS(II),JPBS(II)))) IS_PSER(NPSERS(II))=.TRUE. + ENDDO +!! CARD C19 + DO II=1,NPBW + IF(ISDOMAIN(LIJ(IPBW(II),JPBW(II)))) IS_PSER(NPSERW(II))=.TRUE. + ENDDO +!! CARD C20 + DO II=1,NPBE + IF(ISDOMAIN(LIJ(IPBE(II),JPBE(II)))) IS_PSER(NPSERE(II))=.TRUE. + ENDDO +!! CARD C21 + DO II=1,NPBN + IF(ISDOMAIN(LIJ(IPBN(II),JPBN(II)))) IS_PSER(NPSERN(II))=.TRUE. + ENDDO + ENDIF + +!! CARD C24 + IF(NQSIJ.GT.0)THEN + DO II=1,NQSIJ + IF(ISDOMAIN(LIJ(IQS(II),JQS(II))))THEN + IS_QSER(NQSERQ(II))=.TRUE. + DO JJ=1,4 + IS_CSER(NCSERQ(II,JJ),JJ)=.TRUE. + ENDDO + DO N=1,NTOX + JJ=MSVTOX(N) + IS_CSER(NCSERQ(II,JJ),JJ)=.TRUE. + ENDDO + DO N=1,NSED + JJ=MSVSED(N) + IS_CSER(NCSERQ(II,JJ),JJ)=.TRUE. + ENDDO + DO N=1,NSND + JJ=MSVSND(N) + IS_CSER(NCSERQ(II,JJ),JJ)=.TRUE. + ENDDO + DO NW=1,NWQV + JJ=4+NTOX+NSED+NSND+NW + IS_CSER(:,JJ)=.TRUE. + ENDDO + DO NSP=1,NXSP + JJ=4+NTOX+NSED+NSND+NWQV+NSP + IS_CSER(:,JJ)=.TRUE. + ENDDO + ENDIF + ENDDO + ENDIF + +!! CARD C32 + IF(NQCTL.GT.0)THEN + DO II=1,NQCTL + IF(ISDOMAIN(LIJ(IQCTLU(II),JQCTLU(II))))THEN + IS_QCTL(NQCTLQ(II))=.TRUE. + ENDIF + ENDDO + ENDIF + +!! CARD C47 + IF(NCBS.GT.0)THEN + DO II=1,NCBS + IF(ISDOMAIN(LIJ(ICBS(II),JCBS(II))))THEN + DO JJ=1,4 + IS_CSER(NCSERS(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NTOX + JJ=MSVTOX(N) + IS_CSER(NCSERS(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSED + JJ=MSVSED(N) + IS_CSER(NCSERS(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSND + JJ=MSVSND(N) + IS_CSER(NCSERS(II,2),JJ)=.TRUE. + ENDDO + DO NW=1,NWQV + JJ=4+NTOX+NSED+NSND+NW + IS_CSER(NCSERS(II,JJ),JJ)=.TRUE. + ENDDO + DO NSP=1,NXSP + JJ=4+NTOX+NSED+NSND+NWQV+NSP + IS_CSER(NCSERS(II,JJ),JJ)=.TRUE. + ENDDO + ENDIF + ENDDO + ENDIF + +!! CARD C52 + IF(NCBW.GT.0)THEN + DO II=1,NCBW + IF(ISDOMAIN(LIJ(ICBW(II),JCBW(II))))THEN + DO JJ=1,4 + IS_CSER(NCSERW(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NTOX + JJ=MSVTOX(N) + IS_CSER(NCSERW(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSED + JJ=MSVSED(N) + IS_CSER(NCSERW(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSND + JJ=MSVSND(N) + IS_CSER(NCSERW(II,2),JJ)=.TRUE. + ENDDO + DO NW=1,NWQV + JJ=4+NTOX+NSED+NSND+NW + IS_CSER(NCSERW(II,JJ),JJ)=.TRUE. + ENDDO + DO NSP=1,NXSP + JJ=4+NTOX+NSED+NSND+NW+NWQV+NSP + IS_CSER(NCSERW(II,JJ),JJ)=.TRUE. + ENDDO + ENDIF + ENDDO + ENDIF + +!! CARD C57 + IF(NCBE.GT.0)THEN + DO II=1,NCBE + IF(ISDOMAIN(LIJ(ICBE(II),JCBE(II))))THEN + DO JJ=1,4 + IS_CSER(NCSERE(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NTOX + JJ=MSVTOX(N) + IS_CSER(NCSERE(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSED + JJ=MSVSED(N) + IS_CSER(NCSERE(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSND + JJ=MSVSND(N) + IS_CSER(NCSERE(II,2),JJ)=.TRUE. + ENDDO + DO NW=1,NWQV + JJ=4+NTOX+NSED+NSND+NW + IS_CSER(NCSERE(II,JJ),JJ)=.TRUE. + ENDDO + DO NSP=1,NXSP + JJ=4+NTOX+NSED+NSND+NW+NWQV+NSP + IS_CSER(NCSERE(II,JJ),JJ)=.TRUE. + ENDDO + ENDIF + ENDDO + ENDIF + +!! CARD C62 + IF(NCBN.GT.0)THEN + DO II=1,NCBN + IF(ISDOMAIN(LIJ(ICBN(II),JCBN(II))))THEN + DO JJ=1,4 + IS_CSER(NCSERN(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NTOX + JJ=MSVTOX(N) + IS_CSER(NCSERN(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSED + JJ=MSVSED(N) + IS_CSER(NCSERN(II,2),JJ)=.TRUE. + ENDDO + DO N=1,NSND + JJ=MSVSND(N) + IS_CSER(NCSERN(II,2),JJ)=.TRUE. + ENDDO + DO NW=1,NWQV + JJ=4+NTOX+NSED+NSND+NW + IS_CSER(NCSERN(II,JJ),JJ)=.TRUE. + ENDDO + DO NSP=1,NXSP + JJ=4+NTOX+NSED+NSND+NW+NWQV+NSP + IS_CSER(NCSERN(II,JJ),JJ)=.TRUE. + ENDDO + ENDIF + ENDDO + ENDIF + ENDIF + + ENDSUBROUTINE + +!########################################################################################################### + + SUBROUTINE MPI_MASKDRY + + MPI_IMASKDRY=0 + DO L=1,LA + IF(IMASKDRY(L).EQ.1) MPI_IMASKDRY(L)=1. + ENDDO + + ENDSUBROUTINE + + +END MODULE From 386639cc0dafbd64f36d97f1dc7c7a7ad5749a5a Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 14:51:51 +0100 Subject: [PATCH 23/77] Move variables from function args to globals In NIER these variables are defined in Var_Global_Mod and not explicitly passed towards the subroutines. The subroutine signature is modified accordingly. --- .../efdc_fortran_dll/original_efdc_files/CALFQC.for | 8 ++++---- .../efdc_fortran_dll/original_efdc_files/CALTRAN.for | 6 +++--- .../efdc_fortran_dll/original_efdc_files/COSTRAN.for | 6 +++--- .../efdc_fortran_dll/original_efdc_files/COSTRANW.for | 6 +++--- .../original_efdc_files/Var_Global_Mod.f90 | 4 ++++ 5 files changed, 17 insertions(+), 13 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for index 273220b4d..b51cda77e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for @@ -1,5 +1,5 @@ - SUBROUTINE CALFQC(ISTL_,IS2TL_,MVAR,MO,CON,CON1,FQCPAD,QSUMPAD, - & QSUMNAD) + SUBROUTINE CALFQC(ISTL_,IS2TL_,MVAR,MO,CON,CON1)!,FQCPAD,QSUMPAD, +! & QSUMNAD) C C CHANGE RECORD C ** SUBROUTINE CALFQC CALCULATES MASS SOURCES AND SINKS ASSOCIATED @@ -12,8 +12,8 @@ C INTEGER::L,K,ID,JD,KD,NWR,IU,JU,KU,LU,NS INTEGER::LD,NMD,NJP - DIMENSION CON(LCM,KCM),CON1(LCM,KCM),FQCPAD(0:LCM1,KCM), - & QSUMNAD(0:LCM1,KCM),QSUMPAD(0:LCM1,KCM) + DIMENSION CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(0:LCM1,KCM), +! & QSUMNAD(0:LCM1,KCM),QSUMPAD(0:LCM1,KCM) REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ REAL QVKTMP,QUKTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index c338d7554..4652f514c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -13,9 +13,9 @@ C REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMN REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONTMX - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FQCPAD - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FQCPAD +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD +! REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::POS REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::WQBCCON REAL CTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for index 5af196f54..71fb7cf2e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRAN.for @@ -31,9 +31,9 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::DELCX REAL,ALLOCATABLE,DIMENSION(:,:)::DELCY REAL,ALLOCATABLE,DIMENSION(:,:)::DELCZ - REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD - REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD - REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD CTMP=0.0 RDZIC=0.0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for index 0afbb6542..00e4d8652 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/COSTRANW.for @@ -46,9 +46,9 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::DELCX REAL,ALLOCATABLE,DIMENSION(:,:)::DELCY REAL,ALLOCATABLE,DIMENSION(:,:)::DELCZ - REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD - REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD - REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD +! REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD REAL CSTARP REAL CSTARN REAL CTMP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 index 536a49176..9595ee3d2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Var_Global_Mod.f90 @@ -3930,6 +3930,10 @@ MODULE GLOBAL REAL*8,ALLOCATABLE,DIMENSION(:)::PCG_R8 REAL*8,ALLOCATABLE,DIMENSION(:)::RCG_R8 + REAL,ALLOCATABLE,DIMENSION(:,:)::FQCPAD + REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMNAD + REAL,ALLOCATABLE,DIMENSION(:,:)::QSUMPAD + REAL,SAVE,ALLOCATABLE,DIMENSION(:)::CLOUDTT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::EVAPTT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::PATMTT From 5ae9729074cf84f8210b12e3b6bf1c505cd150c3 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 14:54:12 +0100 Subject: [PATCH 24/77] Extend Makefile to compile MPI sources - Replace gfortran with an MPI aware compiler (mpifort) - Add targets for the newly added MPI module and MPI sources - Add compiler flag -fallow-argument-mismatch to suppress errors resulting from type mismatch in MPI library calls. --- .../original_efdc_files/Makefile | 55 +++++++++++++++++-- 1 file changed, 50 insertions(+), 5 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile index 9bfa728e1..f32dfb625 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile @@ -5,8 +5,8 @@ # #----- Fortran Compiler Settings --------------------------------------------- -# gfortran compiler -MAKE_FF=gfortran +# mpi gfortran compiler +MAKE_FF=mpifort # we want to use linux32 command to simulate 32bit on a 64bit machine MACH = $(shell arch) @@ -28,7 +28,8 @@ endif MAKE_FDEBUG = -g -fbounds-check -Wall -fbacktrace -finit-real=nan -ffpe-trap=invalid,zero,overflow # debug MAKE_FOPTIMIZE = -O # optimize -MAKE_FFLAGS_SPECIFIC = -fPIC -ffixed-line-length-none -ffree-line-length-none # gfortran +# Add '-fallow-argument-mismatch' to suppress errors on type mismatch in mpi library calls +MAKE_FFLAGS_SPECIFIC = -fPIC -ffixed-line-length-none -ffree-line-length-none -fallow-argument-mismatch # gfortran MAKE_FFLAGS = \ $(MAKE_FFLAGS_SPECIFIC) $(MFLAG_ARCH) @@ -75,7 +76,13 @@ CALDIFF.o CALTOX.o CSNDSET.o RCAHQ.o SALTSMTH.o SOLVSMBE.o CALDISP2.o CALTOXB.o CSNDZEQ.o SCANASER.o SCANGTAB.o SSEDTOX.o WQSKE1.o \ CALDISP3.o CALTRAN.o DEPPLT.o SCANDSER.o SUBCHAN.o WQSKE2.o \ VARALLOC1.o VARALLOC2.o VARALLOC3.o VARALLOC4.o VARALLOC5.o VARALLOC6.o VARALLOC7.o VARALLOC8.o\ -CALEBI.o CALTRANQ.o READTOX.o WQSKE3.o pbm_cut.o Sub_spore.o WQSTOKES01.o +CALEBI.o CALTRANQ.o READTOX.o WQSKE3.o pbm_cut.o Sub_spore.o WQSTOKES01.o \ +CALAVB_mpi.o CALAVBOLD_mpi.o CALBUOY_mpi.o CALCONC_mpi.o CALCSER_mpi.o CALDIFF_mpi.o CALEBI_mpi.o \ +CALEXP2T_mpi.o CALFQC_mpi.o CALHDMF_mpi.o CALHEAT_mpi.o CALMMT_mpi.o CALPNHS_mpi.o CALPSER_mpi.o \ +CALPUV2C_mpi.o CALQQ2T_mpi.o CALQQ2TOLD_mpi.o CALQVS_mpi.o CALSFT_mpi.o CALTBXY_mpi.o CALTRAN_mpi.o \ +CALTSXY_mpi.o CALUVW_mpi.o CALVEGSER_mpi.o CALWQC_mpi.o CONGRAD_mpi.o \ +EEXPOUT_mpi.o HDMT2T_mpi.o RWQATM_mpi.o SALPLTH_mpi.o SALTSMTH_mpi.o SETBCS_mpi.o \ +VELPLTH_mpi.o WQ3D_mpi.o WQSKE3_mpi.o COMPAT_OBJS = \ drand.o @@ -127,6 +134,7 @@ clobber: $(MAKE_FF) $(MAKE_FFLAGS) -c $< -o $@ global.mod: Var_Global_Mod.o +mpi.mod: global.mod MPI.o drifter.mod: DRIFTER.o windwave.mod: WINDWAVE.o @@ -140,7 +148,7 @@ CALHEAT.o: global.mod GATECTLREAD.o: global.mod CALPUVTT.o: global.mod READOIL.o: global.mod -CGATEFLX.po: global.mod +CGATEFLX.o: global.mod RESTOUT.o: global.mod VARZEROReal.o: global.mod s_sedzlj.o: global.mod @@ -356,3 +364,40 @@ s_bedload.o: global.mod s_main.o: global.mod s_morph.o: global.mod s_sedic.o: global.mod + + +CALAVB_mpi.o: global.mod mpi.mod +CALAVBOLD_mpi.o: global.mod mpi.mod +CALBUOY_mpi.o: global.mod mpi.mod +CALCONC_mpi.o: global.mod mpi.mod +CALCSER_mpi.o: global.mod mpi.mod +CALDIFF_mpi.o: global.mod mpi.mod +CALEBI_mpi.o: global.mod mpi.mod +CALEXP2T_mpi.o: global.mod mpi.mod +CALFQC_mpi.o: global.mod mpi.mod +CALHDMF_mpi.o: global.mod mpi.mod +CALHEAT_mpi.o: global.mod mpi.mod +CALMMT_mpi.o: global.mod mpi.mod +CALPNHS_mpi.o: global.mod mpi.mod +CALPSER_mpi.o: global.mod mpi.mod +CALPUV2C_mpi.o: global.mod mpi.mod +CALQQ2T_mpi.o: global.mod mpi.mod +CALQQ2TOLD_mpi.o: global.mod mpi.mod +CALQVS_mpi.o: global.mod mpi.mod +CALSFT_mpi.o: global.mod mpi.mod +CALTBXY_mpi.o: global.mod mpi.mod +CALTRAN_mpi.o: global.mod mpi.mod +CALTSXY_mpi.o: global.mod mpi.mod +CALUVW_mpi.o: global.mod mpi.mod +CALVEGSER_mpi.o: global.mod mpi.mod +CALWQC_mpi.o: global.mod mpi.mod +CONGRAD_mpi.o: global.mod mpi.mod +EEXPOUT_mpi.o: global.mod mpi.mod +HDMT2T_mpi.o: global.mod mpi.mod +RWQATM_mpi.o: global.mod mpi.mod +SALPLTH_mpi.o: global.mod mpi.mod +SALTSMTH_mpi.o: global.mod mpi.mod +SETBCS_mpi.o: global.mod mpi.mod +VELPLTH_mpi.o: global.mod mpi.mod +WQ3D_mpi.o: global.mod mpi.mod +WQSKE3_mpi.o: global.mod mpi.mod From 063ebeb0b819e8e67978615e90cfdf6755325ddc Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 17:31:08 +0100 Subject: [PATCH 25/77] Add README to track questionable patches Includes a note regarding missing patches in the NIER version of source file CGATEFLX. --- .../efdc_fortran_dll/original_efdc_files/README.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md new file mode 100644 index 000000000..36bf8c59c --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -0,0 +1,14 @@ +# Merge notes + +For the following files there was no clear, distinct approach to merge +the diffs that were present between the version of EFDC provided by NIER +(start of 2022) and the version present in Openda around the same time. +Each file corresponds with a single commit that introduced the patch for +that file. Note, this might not have been the right way to resolve the +conflicts... + +* `CGATEFLX.for`: The NIER source misses the fix introducing boolean + `HUPG_HDWG_INITIALIZED` that was added in 2016 in OpenDA. + Additionally, the array GKMULT seems not to have been initialized in + all possible situations and could have been used uninitialized in + some. These patches were not brought back to OpenDA. From 9549c0aa31643f7a832d762a466c287aa4a946eb Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 17:38:41 +0100 Subject: [PATCH 26/77] Include NIER patches for HDMT2T --- .../original_efdc_files/CALEXP2T0.for | 1251 ----------------- .../original_efdc_files/HDMT2T.for | 27 +- .../original_efdc_files/Makefile | 2 +- .../original_efdc_files/Makefile.aix | 2 +- .../original_efdc_files/README.md | 6 + 5 files changed, 28 insertions(+), 1260 deletions(-) delete mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for deleted file mode 100644 index daad3925a..000000000 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALEXP2T0.for +++ /dev/null @@ -1,1251 +0,0 @@ - SUBROUTINE CALEXP2T0 -C -C ** SUBROUTINE CALEXP2T CALCULATES EXPLICIT MOMENTUM EQUATION TERMS -C ** USING A TWO TIME LEVEL SCHEME -C CHANGE RECORD -C ADDED BODY FORCES FBODYFX AND FBODYFY TO EXTERNAL MOMENTUM EQUATIONS -C CORRECTED ORIENTATION OF MOMENTUM FLUXES FROM SINKS AND SOURCE -C CORRECTED 2 LAYER (KC=-2) CURVATURE ACCELERATION CORRECTION -C ADDED ICK2COR,CK2UUM,CK2VVM,CK2UVM,CK2UUC,CK2VVC,CK2UVC,CK2FCX, -C CK2FCY TO GENERALIZE TWO LAYER MOMENTUM FLUX AND CURVATURE -C ACCELERATION CORRECTION -C MODIFIED CALCULATION OF CORIOLIS-CURVATURE ACCELERATIONS AT TIDAL -C OPEN BOUNDARIES -C ADDED VIRTUAL MOMENTUM SOURCES AND SINKS FOR SUBGRID SCALE CHANNEL -C INTERACTIONS, INCLUDING LOCAL VARIABLES TMPVEC1,TMPVEC2,QMCSINKX, -C QMCSINKY,QMCSOURX,QMSOURY -C ADDED DRY CELL BYPASS AND CONSISTENT INITIALIZATION OF DRY VALUES -C -C 2008-12 SANG YUK/PMC (DSLLC) CORRECTED THE EXPLICIT INTERNAL BUOYANCY FORCINGS -C - USE GLOBAL - - IMPLICIT NONE - INTEGER::LF,ithds - INTEGER::L,K,LN,LS,ID,JD,KD,NWR,IU,JU,KU,LU,NS,LNW,LSE,LL - INTEGER::LD,NMD,LHOST,LCHNU,LW,LE,LCHNV - REAL::TMPANG,WU,WV,CACSUM,CFEFF,VEAST2,VWEST2,FCORE,FCORW - REAL::UNORT1,USOUT1,UNORT2,USOUT2,FCORN,FCORS,VTMPATU - REAL::UTMPATV,UMAGTMP,VMAGTMP,DZICK,DZICKC,DZPU,DZPV - REAL::RCDZF,TMPVAL,WVFACT,DETH,CI11H,CI12H,CI22H,DETU - REAL::CI11V,CI12V,CI21V,CI22V,CI21H,CI12U,CI21U,CI22U,DETV,CI11U - REAL::UHC,UHB,VHC,VHB,UHC1,UHB1,VHC1,VHB1,UHC2,UHB2,VHC2,VHB2 - REAL::UHB1MX,UHB1MN,VHC1MX,VHC1MN,UHC1MX,UHC1MN,VHB1MX - REAL::VHB1MN,UHB2MX,UHB2MN,VHC2MX,VHC2MN,UHC2MX,UHC2MN,VHB2MX - REAL::VHB2MN,BOTT,QMF,QUMF,VEAST1,VWEST1 - REAL::t02,t03,rtc - - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::DZPC - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPVEC1 - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TMPVEC2 - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FUHJ - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FVHJ - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSINKX - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSINKY - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSOURX - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::QMCSOURY -C - IF(.NOT.ALLOCATED(TMPVEC1))THEN - ALLOCATE(FUHJ(LCM,KCM)) - ALLOCATE(FVHJ(LCM,KCM)) - ALLOCATE(QMCSINKX(LCM,KCM)) - ALLOCATE(QMCSINKY(LCM,KCM)) - ALLOCATE(QMCSOURX(LCM,KCM)) - ALLOCATE(QMCSOURY(LCM,KCM)) - ALLOCATE(TMPVEC1(KCM)) - ALLOCATE(TMPVEC2(KCM)) - ALLOCATE(DZPC(LCM,KCM)) - FUHJ=0. - FVHJ=0. - QMCSINKX=0. - QMCSINKY=0. - QMCSOURX=0. - QMCSOURY=0. - TMPVEC1=0. - TMPVEC2=0. - DZPC=0. - ENDIF -C -c t02=rtc() - IF(ISDYNSTP.EQ.0)THEN - DELT=DT - ELSE - DELT=DTDYN - ENDIF -C - IF(IS2TIM.EQ.2)THEN - DELT=0.5*DT - ENDIF -C - DELTI=1./DELT -C - IF(N.EQ.1.AND.DEBUG)THEN - OPEN(1,FILE='MFLUX.DIA') - CLOSE(1,STATUS='DELETE') - ENDIF -C -C**********************************************************************C -C -C ** INITIALIZE MOMENTUM FLUXES AND CORIOLIS TERMS -C ** INITIALIZE EXTERNAL CORIOLIS-CURVATURE AND ADVECTIVE FLUX TERMS -C -C----------------------------------------------------------------------C -C - DO L=1,LC - FCAXE(L)=0. - FCAYE(L)=0. - FXE(L)=0. - FYE(L)=0. - ENDDO -C -C -C----------------------------------------------------------------------C -C - IF(IS2LMC.NE.1)THEN - DO K=1,KC - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - - UHC=0.5*(UHDY(L,K)+UHDY(LS,K)) - UHB=0.5*(UHDY(L,K)+UHDY(L+1,K)) - VHC=0.5*(VHDX(L,K)+VHDX(L-1,K)) - VHB=0.5*(VHDX(L,K)+VHDX(LN,K)) -C - FUHU(L,K)=MAX(UHB,0.)*U(L, K) ! *** CELL CENTERED - & +MIN(UHB,0.)*U(L+1,K) -c IF(UHB.GE.0.) THEN -c FUHU(L,K)=UHB*U(L, K) -c ELSE -c FUHU(L,K)=UHB*U(L+1, K) -c ENDIF - FVHU(L,K)=MAX(VHC,0.)*U(LS, K) - & +MIN(VHC,0.)*U(L, K) -c IF(VHC.GE.0.) THEN -c FVHU(L,K)=VHC*U(LS, K) -c ELSE -c FVHU(L,K)=VHC*U(L, K) -c ENDIF -C - FVHV(L,K)=MAX(VHB,0.)*V(L, K) ! *** CELL CENTERED - & +MIN(VHB,0.)*V(LN, K) -c IF(VHB.GE.0.) THEN -c FVHV(L,K)=VHB*V(L , K) -c ELSE -c FVHV(L,K)=VHB*V(LN, K) -c ENDIF - FUHV(L,K)=MAX(UHC,0.)*V(L-1,K) - & +MIN(UHC,0.)*V(L, K) -c IF(UHC.GE.0.) THEN -c FUHV(L,K)=UHC*V(L-1, K) -c ELSE -c FUHV(L,K)=UHC*V(L, K) -c ENDIF - ENDDO -c ENDDO -c -c DO K=1,KS - IF(K.LE.KS) THEN - DO L=LF,LL - LS=LSC(L) - WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) - WV=0.5*DXYV(L)*(W(L,K)+W(LS,K)) - - FWU(L,K)=MAX(WU,0.)*U(L,K) - & +MIN(WU,0.)*U(L,K+1) - FWV(L,K)=MAX(WV,0.)*V(L,K) - & +MIN(WV,0.)*V(L,K+1) - - ENDDO - ENDIF - ENDDO -C - ELSE !IF(IS2LMC.EQ.1)THEN -C - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - UHC1=0.5*(UHDY(L,1)+UHDY(LS,1)) - UHB1=0.5*(UHDY(L,1)+UHDY(L+1,1)) - VHC1=0.5*(VHDX(L,1)+VHDX(L-1,1)) - VHB1=0.5*(VHDX(L,1)+VHDX(LN,1)) - UHC2=0.5*(UHDY(L,2)+UHDY(LS,2)) - UHB2=0.5*(UHDY(L,2)+UHDY(L+1,2)) - VHC2=0.5*(VHDX(L,2)+VHDX(L-1,2)) - VHB2=0.5*(VHDX(L,2)+VHDX(LN,2)) -C - UHB1MX=0. - UHB1MN=0. - VHC1MX=0. - VHC1MN=0. - UHC1MX=0. - UHC1MN=0. - VHB1MX=0. - VHB1MN=0. - UHB2MX=0. - UHB2MN=0. - VHC2MX=0. - VHC2MN=0. - UHC2MX=0. - UHC2MN=0. - VHB2MX=0. - VHB2MN=0. -C - BOTT=ABS(UHB1*U(L,1)) - IF(BOTT.GT.0.0) - & UHB1MX=1.+CK2UUM*(UHB2-UHB1)*(U(L,2)-U(L,1))/UHB1*U(L,1) - BOTT=ABS(UHB1*U(L+1,1)) - IF(BOTT.GT.0.0) - & UHB1MN=1.+CK2UUM*(UHB2-UHB1)*(U(L+1,2)-U(L+1,1))/ - & UHB1*U(L+1,1) - BOTT=ABS(VHC1*U(LS,1)) - IF(BOTT.GT.0.0) - & VHC1MX=1.+CK2UVM*(VHC2-VHC1)*(U(LS,2)-U(LS,1))/VHC1* - & U(LS,1) - BOTT=ABS(VHC1*U(L,1)) - IF(BOTT.GT.0.0) - & VHC1MN=1.+CK2UVM*(VHC2-VHC1)*(U(L,2)-U(L,1))/VHC1*U(L,1) - BOTT=ABS(UHC1*V(L-1,1)) - IF(BOTT.GT.0.0) - & UHC1MX=1.+CK2UVM*(UHC2-UHC1)*(V(L-1,2)-V(L-1,1))/ - & UHC1*V(L-1,1) - BOTT=ABS(UHC1*V(L,1)) - IF(BOTT.GT.0.0) - & UHC1MN=1.+CK2UVM*(UHC2-UHC1)*(V(L,2)-V(L,1))/UHC1*V(L,1) - BOTT=ABS(VHB1*V(L,1)) - IF(BOTT.GT.0.0) - & VHB1MX=1.+CK2VVM*(VHB2-VHB1)*(V(L,2)-V(L,1))/VHB1*V(L,1) - BOTT=ABS(VHB1*V(LN,1)) - IF(BOTT.GT.0.0) - & VHB1MN=1.+CK2VVM*(VHB2-VHB1)*(V(LN,2)-V(LN,1))/VHB1* - & V(LN,1) - - BOTT=ABS(UHB2*U(L,2)) - IF(BOTT.GT.0.0) - & UHB2MX=1.+CK2UUM*(UHB2-UHB1)*(U(L,2)-U(L,1))/UHB2*U(L,2) - BOTT=ABS(UHB2*U(L+1,2)) - IF(BOTT.GT.0.0) - & UHB2MN=1.+CK2UUM*(UHB2-UHB1)*(U(L+1,2)-U(L+1,1))/ - & UHB2*U(L+1,2) - BOTT=ABS(VHC2*U(LS,2)) - IF(BOTT.GT.0.0) - & VHC2MX=1.+CK2UVM*(VHC2-VHC1)*(U(LS,2)-U(LS,1))/VHC2* - & U(LS,2) - BOTT=ABS(VHC2*U(L,2)) - IF(BOTT.GT.0.0) - & VHC2MN=1.+CK2UVM*(VHC2-VHC1)*(U(L,2)-U(L,1))/VHC2*U(L,2) - BOTT=ABS(UHC2*V(L-1,2)) - IF(BOTT.GT.0.0) - & UHC2MX=1.+CK2UVM*(UHC2-UHC1)*(V(L-1,2)-V(L-1,1))/ - & UHC2*V(L-1,2) - BOTT=ABS(UHC2*V(L,2)) - IF(BOTT.GT.0.0) - & UHC2MN=1.+CK2UVM*(UHC2-UHC1)*(V(L,2)-V(L,1))/UHC2*V(L,2) - BOTT=ABS(VHB2*V(L,2)) - IF(BOTT.GT.0.0) - & VHB2MX=1.+CK2VVM*(VHB2-VHB1)*(V(L,2)-V(L,1))/VHB2*V(L,2) - BOTT=ABS(VHB2*V(LN,2)) - IF(BOTT.GT.0.0) - & VHB2MN=1.+CK2VVM*(VHB2-VHB1)*(V(LN,2)-V(LN,1))/VHB2* - & V(LN,2) -C - FUHU(L,1)=UHB1MX*MAX(UHB1,0.)*U(L,1) - & +UHB1MN*MIN(UHB1,0.)*U(L+1,1) - FVHU(L,1)=VHC1MX*MAX(VHC1,0.)*U(LS,1) - & +VHC1MN*MIN(VHC1,0.)*U(L,1) - FUHV(L,1)=UHC1MX*MAX(UHC1,0.)*V(L-1,1) - & +UHC1MN*MIN(UHC1,0.)*V(L,1) - FVHV(L,1)=VHB1MX*MAX(VHB1,0.)*V(L,1) - & +VHB1MN*MIN(VHB1,0.)*V(LN,1) - FUHJ(L,1)=0. - FVHJ(L,1)=0. - FUHU(L,2)=UHB2MX*MAX(UHB2,0.)*U(L,2) - & +UHB2MN*MIN(UHB2,0.)*U(L+1,2) - FVHU(L,2)=VHC2MX*MAX(VHC2,0.)*U(LS,2) - & +VHC2MN*MIN(VHC2,0.)*U(L,2) - FUHV(L,2)=UHC2MX*MAX(UHC2,0.)*V(L-1,2) - & +UHC2MN*MIN(UHC2,0.)*V(L,2) - FVHV(L,2)=VHB2MX*MAX(VHB2,0.)*V(L,2) - & +VHB2MN*MIN(VHB2,0.)*V(LN,2) - FUHJ(L,2)=0. - FVHJ(L,2)=0. - ENDDO -c - DO K=1,KS - DO L=LF,LL - LS=LSC(L) - WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) - WV=0.5*DXYV(L)*(W(L,K)+W(LS,K)) - - FWU(L,K)=MAX(WU,0.)*U(L,K) - & +MIN(WU,0.)*U(L,K+1) - FWV(L,K)=MAX(WV,0.)*V(L,K) - & +MIN(WV,0.)*V(L,K+1) - - ENDDO - ENDDO - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 1----->',t03*1.e3,nthds,IS2LMC - -C -C ADD RETURN FLOW MOMENTUM FLUX -C - DO NWR=1,NQWR - IF(NQWRMFU(NWR).GT.0)THEN - IU=IQWRU(NWR) - JU=JQWRU(NWR) - KU=KQWRU(NWR) - LU=LIJ(IU,JU) - NS=NQWRSERQ(NWR) - QMF=QWR(NWR)+QWRSERT(NS) - QUMF=QMF*QMF/(H1P(LU)*DZC(KU)*DZC(KU)*BQWRMFU(NWR)) - IF(NQWRMFU(NWR).EQ.1) FUHJ(LU ,KU)=QUMF - IF(NQWRMFU(NWR).EQ.2) FVHJ(LU ,KU)=QUMF - IF(NQWRMFU(NWR).EQ.3) FUHJ(LU+1 ,KU)=QUMF - IF(NQWRMFU(NWR).EQ.4) FVHJ(LNC(LU),KU)=QUMF - IF(NQWRMFU(NWR).EQ.-1) FUHJ(LU ,KU)=-QUMF - IF(NQWRMFU(NWR).EQ.-2) FVHJ(LU ,KU)=-QUMF - IF(NQWRMFU(NWR).EQ.-3) FUHJ(LU+1 ,KU)=-QUMF - IF(NQWRMFU(NWR).EQ.-4) FVHJ(LNC(LU),KU)=-QUMF - ENDIF - IF(NQWRMFD(NWR).GT.0)THEN - ID=IQWRD(NWR) - JD=JQWRD(NWR) - KD=KQWRD(NWR) - LD=LIJ(ID,JD) - TMPANG=0.017453*ANGWRMFD(NWR) - TMPANG=COS(TMPANG) - NS=NQWRSERQ(NWR) - QMF=QWR(NWR)+QWRSERT(NS) - QUMF=TMPANG*QMF*QMF/(H1P(LD)*DZC(KD)*DZC(KD)*BQWRMFD(NWR)) - IF(NQWRMFD(NWR).EQ.1) FUHJ(LD ,KD)=-QUMF - IF(NQWRMFD(NWR).EQ.2) FVHJ(LD ,KD)=-QUMF - IF(NQWRMFD(NWR).EQ.3) FUHJ(LD+1 ,KD)=-QUMF - IF(NQWRMFD(NWR).EQ.4) FVHJ(LNC(LD),KD)=-QUMF - IF(NQWRMFD(NWR).EQ.-1) FUHJ(LD ,KD)=QUMF - IF(NQWRMFD(NWR).EQ.-2) FVHJ(LD ,KD)=QUMF - IF(NQWRMFD(NWR).EQ.-3) FUHJ(LD+1 ,KD)=QUMF - IF(NQWRMFD(NWR).EQ.-4) FVHJ(LNC(LD),KD)=QUMF -C IF(N.LE.4.AND.DEBUG)THEN -C WRITE(1,1112)N,NWR,NS,ID,JD,KD,NQWRMFD(NWR),H1P(LD),QMF, -C & QUMF,FUHJ(LD,KD),FVHJ(LD,KD) -C ENDIF - ENDIF - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 2----->',t03*1.e3,nthds -C -C ** HARDWIRE FOR PEACH BOTTOM -C -C DO K=1,KC -C FVHV(535,K)=700./H1P(535) -C ENDDO -C -C ** END HARDWIRE FOR PEACH BOTTOM -C -C----------------------------------------------------------------------C -C -C *** COMPUTE VERTICAL ACCELERATIONS -C -c DO K=1,KS -c DO L=2,LA -c LS=LSC(L) -c WU=0.5*DXYU(L)*(W(L,K)+W(L-1,K)) -c WV=0.5*DXYV(L)*(W(L,K)+W(LS,K)) - -c FWU(L,K)=MAX(WU,0.)*U(L,K) -c & +MIN(WU,0.)*U(L,K+1) -c FWV(L,K)=MAX(WV,0.)*V(L,K) -c & +MIN(WV,0.)*V(L,K+1) -c -c ENDDO -c ENDDO -C -C**********************************************************************C -C -C ** BLOCK MOMENTUM FLUX ON LAND SIDE OF TRIANGULAR CELLS -C - IF(ITRICELL.GT.0)THEN - DO K=1,KC - DO L=2,LA - FUHU(L,K)=STCUV(L)*FUHU(L,K) - FVHV(L,K)=STCUV(L)*FVHV(L,K) - ENDDO - ENDDO - ENDIF -C -c t03=rtc()-t02 -c write(6,*) 'Timing 3----->',t03*1.e3,nthds -C**********************************************************************C -C -C ** CALCULATE CORIOLIS AND CURVATURE ACCELERATION COEFFICIENTS -C -C----------------------------------------------------------------------C -C - CACSUM=0. - CFMAX=CF - IF(ISCURVATURE)THEN - - IF(ISDCCA.EQ.0)THEN -C - DO K=1,KC - DO L=2,LA - LN=LNC(L) - CAC(L,K)=( FCORC(L)*DXYP(L) - & +0.5*SNLT*(V(LN,K)+V(L,K))*DYDI(L) - & -0.5*SNLT*(U(L+1,K)+U(L,K))*DXDJ(L) )*HP(L) - ENDDO - ENDDO - DO K=1,KC - DO L=2,LA - CACSUM=CACSUM+CAC(L,K) - ENDDO - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 40---->',t03*1.e3,nthds -C - ELSE -C -C - DO K=1,KC - DO L=2,LA - LN=LNC(L) - CAC(L,K)=( FCORC(L)*DXYP(L) - & +0.5*SNLT*(V(LN,K)+V(L,K))*DYDI(L) - & -0.5*SNLT*(U(L+1,K)+U(L,K))*DXDJ(L) )*HP(L) - CFEFF=ABS(CAC(L,K))*DXYIP(L)*HPI(L) - CFMAX=MAX(CFMAX,CFEFF) - CACSUM=CACSUM+CAC(L,K) - ENDDO - ENDDO -C - IF(N.EQ.NTS.AND.DEBUG)THEN - OPEN(1,FILE='CORC1.DIA') - CLOSE(1,STATUS='DELETE') - OPEN(1,FILE='CORC1.DIA') - K=1 - DO L=2,LA - LN=LNC(L) - WRITE(1,1111)IL(L),JL(L),LN,V(LN,K),V(L,K),DYU(L+1), - & DYU(L),U(L+1,K),U(L,K),DXV(LN),DXV(L),HP(L),CAC(L,K) - ENDDO - CLOSE(1) - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 4----->',t03*1.e3,nthds - ENDIF - - ! *** ENSURE FCAY & FCAX ARE RESET - CACSUM=ABS(CACSUM) - IF(CACSUM.LT.1.E-7)THEN - DO K=1,KC - DO L=2,LA - FCAX(L,K)=0. - FCAY(L,K)=0. - ENDDO - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 5----->',t03*1.e3,nthds - ENDIF - - ENDIF -C - 1111 FORMAT(3I5,10E13.4) - 1113 FORMAT(2I5,10E13.4) -C -C**********************************************************************C -C -C ** CALCULATE CORIOLIS-CURVATURE AND ADVECTIVE ACCELERATIONS -C -C----------------------------------------------------------------------C -C -C ** STANDARD CALCULATION -C - IF(IS2LMC.EQ.0.AND.CACSUM.GT.1.E-7)THEN - - DO K=1,KC - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - LNW=LNWC(L) - LSE=LSEC(L) - FCAX(L,K)=0.25*SCAX(L)*(CAC(L,K)*(V(LN,K)+V(L,K)) - & +CAC(L-1,K)*(V(LNW,K)+V(L-1,K))) - FCAY(L,K)=0.25*SCAY(L)*(CAC(L,K)*(U(L+1,K)+U(L,K)) - & +CAC(LS,K)*(U(LSE,K)+U(LS,K))) - ENDDO - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 6----->',t03*1.e3,nthds -C -C----------------------------------------------------------------------C -C -C ** MODIFICATION FOR TYPE 2 OPEN BOUNDARIES -C - DO K=1,KC - DO LL=1,NPBW - IF(ISPBW(LL).EQ.2)THEN - L=LPBW(LL)+1 - LN=LNC(L) - FCAX(L,K)=0.5*SCAX(L)*CAC(L,K)*(V(LN,K)+V(L,K)) - ENDIF - ENDDO -C - DO LL=1,NPBE - IF(ISPBE(LL).EQ.2)THEN - L=LPBE(LL) - LNW=LNWC(L) - FCAX(L,K)=0.5*SCAX(L)*CAC(L-1,K)*(V(LNW,K)+V(L-1,K)) - ENDIF - ENDDO -C - DO LL=1,NPBS - IF(ISPBS(LL).EQ.2)THEN - L=LNC(LPBS(LL)) - FCAY(L,K)=0.5*SCAY(L)*CAC(L,K)*(U(L+1,K)+U(L,K)) - ENDIF - ENDDO -C - DO LL=1,NPBN - IF(ISPBN(LL).EQ.2)THEN - L=LPBN(LL) - LS=LSC(L) - LSE=LSEC(L) - FCAY(L,K)=0.5*SCAY(L)*CAC(LS,K)*(U(LSE,K)+U(LS,K)) - ENDIF - ENDDO - ENDDO - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 7----->',t03*1.e3,nthds -C -C----------------------------------------------------------------------C -C -C *** CALCULATION FOR MOMENTUM-CURVATURE CORRECTION -C *** PMC - USED TO BE ONLY FOR 2 LAYERS, JH ALLOWED ANY # OF LAYERS -C - IF(IS2LMC.EQ.1.AND.CACSUM.GT.1.E-7)THEN -CJH IF(KC.EQ.2)THEN - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - LNW=LNWC(L) - LSE=LSEC(L) -C - VEAST1=V(LN,1)+V(L,1) - VWEST1=V(LNW,1)+V(L-1,1) - VEAST2=V(LN,2)+V(L,2) - VWEST2=V(LNW,2)+V(L-1,2) - FCORE=CK2FCX*(CAC(L,2)-CAC(L,1))*(VEAST2-VEAST1) - FCORW=CK2FCX*(CAC(L-1,2)-CAC(L-1,1))*(VWEST2-VWEST1) -C - FCAX(L,1)=0.25*SCAX(L)*( - & CAC(L,1)*VEAST1+FCORE - & +CAC(L-1,1)*VWEST1+FCORW) -C - FCAX(L,2)=0.25*SCAX(L)*( - & CAC(L,2)*VEAST2+FCORE - & +CAC(L-2,2)*VWEST2+FCORW) -C - UNORT1=U(L+1,1)+U(L,1) - USOUT1=U(LSE,1)+U(LS,1) - UNORT2=U(L+1,2)+U(L,2) - USOUT2=U(LSE,2)+U(LS,2) - FCORN=CK2FCY*(CAC(L,2)-CAC(L,1))*(UNORT2-UNORT1) - FCORS=CK2FCY*(CAC(LS,2)-CAC(LS,1))*(USOUT2-USOUT1) -C - FCAY(L,1)=0.25*SCAY(L)*( - & CAC(L,1)*UNORT1+FCORN - & +CAC(LS,1)*USOUT1+FCORS) -C - FCAY(L,2)=0.25*SCAY(L)*( - & CAC(L,2)*UNORT2+FCORN - & +CAC(LS,2)*USOUT2+FCORS) -C - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 8----->',t03*1.e3,nthds - ENDIF -C -C----------------------------------------------------------------------C -C - DO K=1,KC - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - !HRUO(L)=SUBO(L)*DYU(L)*DXIU(L) - !HRXYU(L)=DXU(L)/DYU(L) ! PMC - NOT USED - FX(L,K)=(FUHU(L,K)-FUHU(L-1,K)+FVHU(LN,K)-FVHU(L,K) - & +FUHJ(L,K) ) - FY(L,K)=(FUHV(L+1,K)-FUHV(L,K)+FVHV(L,K)-FVHV(LS,K) - & +FVHJ(L,K) ) - ENDDO - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 9----->',t03*1.e3,nthds - - ! *** TREAT BC'S NEAR EDGES - DO LL=1,NBCS - ! *** BC CELL - L=LBCS(LL) - DO K=1,KC - FX(L,K)=SAAX(L)*FX(L,K) - FY(L,K)=SAAY(L)*FY(L,K) - ENDDO - - ! *** EAST/WEST ADJACENT CELL - L=LBERC(LL) - DO K=1,KC - FX(L,K)=SAAX(L)*FX(L,K) - ENDDO - - ! *** NORTH/SOUTH ADJACENT CELL - L=LBNRC(LL) - DO K=1,KC - FY(L,K)=SAAY(L)*FY(L,K) - ENDDO - ENDDO -c t03=rtc()-t02 -c write(6,*) 'Timing 10---->',t03*1.e3,nthds -C -C----------------------------------------------------------------------C -C -C ** CORIOLIS-CURVATURE DIAGNOSTICS -C - IF(ISDCCA.EQ.1.AND.DEBUG)THEN - IF(N.EQ.NTS)THEN - OPEN(1,FILE='CORC2.DIA') - CLOSE(1,STATUS='DELETE') - OPEN(1,FILE='CORC2.DIA') - K=1 - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - LNW=LNWC(L) - LSE=LSEC(L) - WRITE(1,1113)IL(L),JL(L),CAC(L,K),V(LN,K),V(L,K), - & CAC(L-1,K),V(LNW,K),V(L-1,K) - ENDDO - CLOSE(1) - ENDIF -C - IF(N.EQ.NTS)THEN - OPEN(1,FILE='CORC3.DIA') - CLOSE(1,STATUS='DELETE') - OPEN(1,FILE='CORC3.DIA') - K=1 - DO L=2,LA - LN=LNC(L) - LS=LSC(L) - LNW=LNWC(L) - LSE=LSEC(L) - WRITE(1,1113)IL(L),JL(L),CAC(L,K),U(L+1,K),U(L,K), - & CAC(LS,K),U(LSE,K),U(LS,K) - ENDDO - CLOSE(1) - ENDIF -C - IF(N.EQ.NTS)THEN - OPEN(1,FILE='CORC4.DIA') - CLOSE(1,STATUS='DELETE') - OPEN(1,FILE='CORC4.DIA') - DO L=2,LA - WRITE(1,1113)IL(L),JL(L),(FCAX(L,K),K=1,KC) - ENDDO - DO L=2,LA - WRITE(1,1113)IL(L),JL(L),(FCAY(L,K),K=1,KC) - ENDDO - CLOSE(1) - ENDIF - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 11---->',t03*1.e3,nthds,ISVEG,ISHDMF -C -C**********************************************************************C -C -C ** ADD VEGETATION DRAG TO HORIZONTAL ADVECTIVE ACCELERATIONS -C -C----------------------------------------------------------------------C -C - IF(ISVEG.GE.1)THEN -C - DO L=1,LC - FXVEGE(L)=0. - FYVEGE(L)=0. - ENDDO -C - DO K=1,KC - DO L=2,LA - LW=L-1 - LE=L+1 - LS=LSC(L) - LN=LNC(L) - LNW=LNWC(L) - LSE=LSEC(L) - VTMPATU=0.25*(V(L,K)+V(LW,K)+V(LN,K)+V(LNW,K)) - UTMPATV=0.25*(U(L,K)+U(LE,K)+U(LS,K)+U(LSE,K)) - UMAGTMP=SQRT( U(L,K)*U(L,K)+VTMPATU*VTMPATU ) - VMAGTMP=SQRT( UTMPATV*UTMPATV+V(L,K)*V(L,K) ) - FXVEG(L,K)=UMAGTMP*SUB(L)*DXYU(L)*FXVEG(L,K) - FYVEG(L,K)=VMAGTMP*SVB(L)*DXYV(L)*FYVEG(L,K) - FXVEGE(L)=FXVEGE(L)+FXVEG(L,K)*DZC(K) - FYVEGE(L)=FYVEGE(L)+FYVEG(L,K)*DZC(K) - ENDDO - ENDDO -C - DO K=1,KC - DO L=2,LA - FXVEG(L,K)=FXVEG(L,K)*U(L,K) - FYVEG(L,K)=FYVEG(L,K)*V(L,K) - FX(L,K)=FX(L,K)+FXVEG(L,K)-FXVEGE(L)*U(L,K) - FY(L,K)=FY(L,K)+FYVEG(L,K)-FYVEGE(L)*V(L,K) - ENDDO - ENDDO -C - DO L=2,LA - FXVEGE(L)=DXYIU(L)*FXVEGE(L)/HU(L) - FYVEGE(L)=DXYIV(L)*FYVEGE(L)/HV(L) - ENDDO -C - ENDIF -C - 1947 FORMAT(3I5,10E12.4) - 1948 FORMAT(15X,10E12.4) -C -C**********************************************************************C -C -C ** ADD HORIZONTAL MOMENTUM DIFFUSION TO ADVECTIVE ACCELERATIONS -C -C----------------------------------------------------------------------C -C - IF(ISHDMF.GE.1)THEN -C - DO K=1,KC - DO L=2,LA - FX(L,K)=FX(L,K)-(FMDUX(L,K)+FMDUY(L,K)) - FY(L,K)=FY(L,K)-(FMDVX(L,K)+FMDVY(L,K)) - ENDDO - ENDDO -C - ENDIF -C -C**********************************************************************C -C -C ** ADD BODY FORCE TO ADVECTIVE ACCELERATIONS -C ** DISTRIBUTE UNIFORMLY OVER ALL LAYERS IF ISBODYF=1 -C ** DISTRIBUTE OVER SURFACE LAYER IF ISBODYF=2 -C -C----------------------------------------------------------------------C -C - IF(ISBODYF.EQ.1)THEN -C - DO K=1,KC - DZICK=1./DZC(K) - DO L=2,LA - FX(L,K)=FX(L,K)-DYU(L)*HU(L)*FBODYFX(L) - FY(L,K)=FY(L,K)-DXV(L)*HV(L)*FBODYFY(L) - ENDDO - ENDDO -C - ENDIF -C - IF(ISBODYF.EQ.2)THEN -C - DZICKC=1./DZC(KC) - DO L=2,LA - FX(L,KC)=FX(L,KC)-DZICKC*DYU(L)*HU(L)*FBODYFX(L) - FY(L,KC)=FY(L,KC)-DZICKC*DXV(L)*HV(L)*FBODYFY(L) - ENDDO -C - ENDIF -C -C**********************************************************************C -C -C ** ADD EXPLICIT NONHYDROSTATIC PRESSURE -C - IF(KC.GT.1.AND.ISPNHYDS.GE.1) THEN -C - TMPVAL=2./(DZC(1)+DZC(2)) - DO L=2,LA - DZPC(L,1)=TMPVAL*(PNHYDS(L,2)-PNHYDS(L,1)) - ENDDO -C - TMPVAL=2./(DZC(KC)+DZC(KC-1)) - DO L=2,LA - DZPC(L,KC)=TMPVAL*(PNHYDS(L,KC)-PNHYDS(L,KC-1)) - ENDDO - - IF(KC.GE.3)THEN - DO K=2,KS - TMPVAL=2./(DZC(K+1)+2.*DZC(K)+DZC(K-1)) - DO L=2,LA - DZPC(L,K)=TMPVAL*(PNHYDS(L,K+1)-PNHYDS(L,K-1)) - ENDDO - ENDDO - ENDIF -C - DO K=1,KC - DO L=2,LA - LS=LSC(L) - DZPU=0.5*(DZPC(L,K)+DZPC(L-1,K)) - DZPV=0.5*(DZPC(L,K)+DZPC(LS ,K)) - FX(L,K)=FX(L,K)+SUB(L)*DYU(L)* - & ( HU(L)*(PNHYDS(L,K)-PNHYDS(L-1,K)) - & -( BELV(L)-BELV(L-1)+ZZ(K)*(HP(L)-HP(L-1)) )*DZPU ) - FY(L,K)=FY(L,K)+SVB(L)*DXV(L)* - & ( HV(L)*(PNHYDS(L,K)-PNHYDS(LS ,K)) - & -( BELV(L)-BELV(LS )+ZZ(K)*(HP(L)-HP(LS )) )*DZPV ) - ENDDO - ENDDO -C - ENDIF -C -C----------------------------------------------------------------------C -C -C ** ADD NET WAVE REYNOLDS STRESSES TO EXTERNAL ADVECTIVE ACCEL. -C -C *** DSLLC BEGIN BLOCK - IF(ISWAVE.EQ.2)THEN -C - IF(N.LT.NTSWV)THEN - TMPVAL=FLOAT(N)/FLOAT(NTSWV) - WVFACT=0.5-0.5*COS(PI*TMPVAL) - ELSE - WVFACT=1.0 - ENDIF -C - DO K=1,KC - DO L=2,LA - FX(L,K)=FX(L,K)+WVFACT*SAAX(L)*FXWAVE(L,K) - FY(L,K)=FY(L,K)+WVFACT*SAAY(L)*FYWAVE(L,K) - ENDDO - ENDDO -C - ENDIF -C *** DSLLC END BLOCK -C -C**********************************************************************C -C -C ** CALCULATE EXTERNAL ACCELERATIONS -C -C----------------------------------------------------------------------C -c t03=rtc()-t02 -c write(6,*) 'Timing 12---->',t03*1.e3,nthds -C - IF(KC.GT.1)THEN -C -C**********************************************************************C -C -C ** COMPLETE CALCULATION OF INTERNAL ADVECTIVE ACCELERATIONS -C -C----------------------------------------------------------------------C -C - DO K=1,KC - DO L=2,LA - FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) - FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) - FXE(L)=FXE(L)+FX(L,K)*DZC(K) - FYE(L)=FYE(L)+FY(L,K)*DZC(K) - FX(L,K)=FX(L,K)+SAAX(L)*(FWU(L,K)-FWU(L,K-1))*DZIC(K) - FY(L,K)=FY(L,K)+SAAY(L)*(FWV(L,K)-FWV(L,K-1))*DZIC(K) - ENDDO - ENDDO - ELSE - DO K=1,KC - DO L=LF,LL - FCAXE(L)=FCAXE(L)+FCAX(L,K)*DZC(K) - FCAYE(L)=FCAYE(L)+FCAY(L,K)*DZC(K) - FXE(L)=FXE(L)+FX(L,K)*DZC(K) - FYE(L)=FYE(L)+FY(L,K)*DZC(K) - ENDDO - ENDDO - ENDIF -C -C**********************************************************************C -C -C ** ADD SUBGRID SCALE CHANNEL VIRTURAL MOMENTUM SOURCES AND SINKS -C -C----------------------------------------------------------------------C -C - IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN -C - DO K=1,KC - DO L=2,LA - QMCSOURX(L,K)=0. - QMCSOURY(L,K)=0. - QMCSINKX(L,K)=0. - QMCSINKY(L,K)=0. - ENDDO - ENDDO - ENDIF -C -c t03=rtc()-t02 -c write(6,*) 'Timing 13---->',t03*1.e3,nthds - IF(MDCHH.GE.1.AND.ISCHAN.EQ.3)THEN -C - DO NMD=1,MDCHH -C - LHOST=LMDCHH(NMD) - LCHNU=LMDCHU(NMD) - LCHNV=LMDCHV(NMD) -C - DETH=CUE(LHOST)*CVN(LHOST)-CUN(LHOST)*CVE(LHOST) - CI11H=CVN(LHOST)/DETH - CI12H=-CUN(LHOST)/DETH - CI21H=-CVE(LHOST)/DETH - CI22H=CUE(LHOST)/DETH -C - DETU=CUE(LCHNU)*CVN(LCHNU)-CUN(LCHNU)*CVE(LCHNU) - CI11U=CVN(LCHNU)/DETU - CI12U=-CUN(LCHNU)/DETU - CI21U=-CVE(LCHNU)/DETU - CI22U=CUE(LCHNU)/DETU -C - DETV=CUE(LCHNV)*CVN(LCHNV)-CUN(LCHNV)*CVE(LCHNV) - CI11V=CVN(LCHNV)/DETV - CI12V=-CUN(LCHNV)/DETV - CI21V=-CVE(LCHNV)/DETV - CI22V=CUE(LCHNV)/DETV -C -C X-DIRECTION CHANNEL - IF(MDCHTYP(NMD).EQ.1)THEN - IF(QCHANU(NMD).GT.0.0)THEN - DO K=1,KC - QMCSINKX(LCHNU,K)=QMCSINKX(LCHNU,K) - & -0.5*DZC(K)*QCHANU(NMD)*(U(LCHNU,K)+U(LCHNU+1,K)) - QMCSINKY(LCHNU,K)=QMCSINKY(LCHNU,K) - & -0.5*DZC(K)*QCHANU(NMD)*(V(LCHNU,K)+V(LNC(LCHNU),K)) - ENDDO - DO K=1,KC - TMPVEC1(K)=CUE(LCHNU)*QMCSINKX(LCHNU,K) - & +CVE(LCHNU)*QMCSINKY(LCHNU,K) - TMPVEC2(K)=CUN(LCHNU)*QMCSINKX(LCHNU,K) - & +CVN(LCHNU)*QMCSINKY(LCHNU,K) - ENDDO - DO K=1,KC - QMCSOURX(LHOST,K)=QMCSOURX(LHOST,K) - & +CI11H*TMPVEC1(K)+CI12H*TMPVEC2(K) - QMCSOURY(LHOST,K)=QMCSOURY(LHOST,K) - & +CI21H*TMPVEC1(K)+CI22H*TMPVEC2(K) - ENDDO - ELSE - DO K=1,KC - QMCSINKX(LHOST,K)=QMCSINKX(LHOST,K) - & +0.5*DZC(K)*QCHANU(NMD)*(U(LHOST,K)+U(LHOST+1,K)) - QMCSINKY(LHOST,K)=QMCSINKY(LCHNU,K) - & +0.5*DZC(K)*QCHANU(NMD)*(V(LHOST,K)+V(LNC(LHOST),K)) - ENDDO - DO K=1,KC - TMPVEC1(K)=CUE(LHOST)*QMCSINKX(LHOST,K) - & +CVE(LHOST)*QMCSINKY(LHOST,K) - TMPVEC2(K)=CUN(LHOST)*QMCSINKX(LCHNU,K) - & +CVN(LHOST)*QMCSINKY(LHOST,K) - ENDDO - DO K=1,KC - QMCSOURX(LCHNU,K)=QMCSOURX(LCHNU,K) - & -CI11U*TMPVEC1(K)-CI12U*TMPVEC2(K) - QMCSOURY(LCHNU,K)=QMCSOURY(LCHNU,K) - & -CI21U*TMPVEC1(K)-CI22U*TMPVEC2(K) - ENDDO - ENDIF - ENDIF -C -C Y-DIRECTION CHANNEL - IF(MDCHTYP(NMD).EQ.2)THEN - IF(QCHANV(NMD).GT.0.0)THEN - DO K=1,KC - QMCSINKX(LCHNV,K)=QMCSINKX(LCHNV,K) - & -0.5*DZC(K)*QCHANV(NMD)*(U(LCHNV,K)+U(LCHNV+1,K)) - QMCSINKY(LCHNV,K)=QMCSINKY(LCHNV,K) - & -0.5*DZC(K)*QCHANV(NMD)*(V(LCHNV,K)+V(LNC(LCHNV),K)) - ENDDO - DO K=1,KC - TMPVEC1(K)=CUE(LCHNV)*QMCSINKX(LCHNV,K) - & +CVE(LCHNV)*QMCSINKY(LCHNV,K) - TMPVEC2(K)=CUN(LCHNV)*QMCSINKX(LCHNV,K) - & +CVN(LCHNV)*QMCSINKY(LCHNV,K) - ENDDO - DO K=1,KC - QMCSOURX(LHOST,K)=QMCSOURX(LHOST,K) - & +CI11H*TMPVEC1(K)+CI12H*TMPVEC2(K) - QMCSOURY(LHOST,K)=QMCSOURY(LHOST,K) - & +CI21H*TMPVEC1(K)+CI22H*TMPVEC2(K) - ENDDO - ELSE - DO K=1,KC - QMCSINKX(LHOST,K)=QMCSINKX(LHOST,K) - & +0.5*DZC(K)*QCHANV(NMD)*(U(LHOST,K)+U(LHOST+1,K)) - QMCSINKY(LHOST,K)=QMCSINKY(LCHNV,K) - & +0.5*DZC(K)*QCHANV(NMD)*(V(LHOST,K)+V(LNC(LHOST),K)) - ENDDO - DO K=1,KC - TMPVEC1(K)=CUE(LHOST)*QMCSINKX(LHOST,K) - & +CVE(LHOST)*QMCSINKY(LHOST,K) - TMPVEC2(K)=CUN(LHOST)*QMCSINKX(LCHNU,K) - & +CVN(LHOST)*QMCSINKY(LHOST,K) - ENDDO - DO K=1,KC - QMCSOURX(LCHNV,K)=QMCSOURX(LCHNV,K) - & -CI11V*TMPVEC1(K)-CI12V*TMPVEC2(K) - QMCSOURY(LCHNV,K)=QMCSOURY(LCHNV,K) - & -CI21V*TMPVEC1(K)-CI22V*TMPVEC2(K) - ENDDO - ENDIF - ENDIF -C - ENDDO -C - DO K=1,KC - DO L=2,LA - IF(QMCSOURX(L,K).NE.0.0)THEN - TMPVAL=SUB(L)+SUB(L+1) - TMPVAL=MAX(TMPVAL,1.0) - FX(L,K)=FX(L,K)-SUB(L)*QMCSOURX(L,K)/TMPVAL - FX(L+1,K)=FX(L+1,K)-SUB(L+1)*QMCSOURX(L,K)/TMPVAL - ENDIF - IF(QMCSOURY(L,K).NE.0.0)THEN - LN=LNC(L) - TMPVAL=SVB(L)+SVB(LN) - TMPVAL=MAX(TMPVAL,1.0) - FY(L,K)=FY(L,K)-SVB(L)*QMCSOURX(L,K)/TMPVAL - FY(LN,K)=FY(LN,K)-SVB(LN)*QMCSOURX(L,K)/TMPVAL - ENDIF - IF(QMCSINKX(L,K).NE.0.0)THEN - TMPVAL=SUB(L)+SUB(L+1) - TMPVAL=MAX(TMPVAL,1.0) - FX(L,K)=FX(L,K)-SUB(L)*QMCSINKX(L,K)/TMPVAL - FX(L+1,K)=FX(L+1,K)-SUB(L+1)*QMCSINKX(L,K)/TMPVAL - ENDIF - IF(QMCSINKY(L,K).NE.0.0)THEN - LN=LNC(L) - TMPVAL=SVB(L)+SVB(LNC(L)) - TMPVAL=MAX(TMPVAL,1.0) - FY(L,K)=FY(L,K)-SVB(L)*QMCSINKX(L,K)/TMPVAL - FY(LN,K)=FY(LN,K)-SVB(LN)*QMCSINKX(L,K)/TMPVAL - ENDIF - ENDDO - ENDDO -C -c t03=rtc()-t02 -c write(6,*) 'Timing 20---->',t03*1.e3,nthds,BSC,IINTPG - ENDIF -C -C**********************************************************************C -C -C ** CALCULATE EXPLICIT INTERNAL BUOYANCY FORCINGS CENTERED AT N FOR -C ** THREE TIME LEVEL STEP AND AT (N+1/2) FOR TWO TIME LEVEL STEP -C ** SBX=SBX*0.5*DYU & SBY=SBY*0.5*DXV -C -C----------------------------------------------------------------------C -C -c IINTPG=0 -C -C ORIGINAL -C - IF(BSC.GT.1.E-6)THEN - - IF(IINTPG.EQ.0)THEN -C - DO K=1,KS - DO L=2,LA - LS=LSC(L) - FBBX(L,K)=SBX(L)*GP*HU(L)* - & ( HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) - & +(B(L,K)-B(L-1,K))*DZC(K) ) - & -(B(L,K+1)-B(L,K)+B(L-1,K+1)-B(L-1,K))* - & (BELV(L)-BELV(L-1)+Z(K)*(HP(L)-HP(L-1))) ) - FBBY(L,K)=SBY(L)*GP*HV(L)* - & ( HV(L)*( (B(L,K+1)-B(LS,K+1))*DZC(K+1) - & +(B(L,K)-B(LS,K))*DZC(K) ) - & -(B(L,K+1)-B(L,K)+B(LS,K+1)-B(LS,K))* - & (BELV(L)-BELV(LS)+Z(K)*(HP(L)-HP(LS))) ) - ENDDO - ENDDO -C - ENDIF -C -C *** JACOBIAN -C - IF(IINTPG.EQ.1.)THEN - K=1 - DO L=2,LA - LS=LSC(L) - FBBX(L,K)=SBX(L)*GP*HU(L)* - & ( 0.5*HU(L)*( (B(L,K+2)-B(L-1,K+2))*DZC(K+2) - & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) - & +(B(L,K )-B(L-1,K ))*DZC(K ) - & +(B(L,K )-B(L-1,K ))*DZC(K ) ) - & -0.5*(B(L,K+2)-B(L,K+1)+B(L-1,K+2)-B(L-1,K+1))* - & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) - & -0.5*(B(L,K )-B(L,K )+B(L-1,K )-B(L-1,K ))* - & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) -C - FBBY(L,K)=SBY(L)*GP*HV(L)* - & ( 0.5*HV(L)*( (B(L,K+2)-B(LS ,K+2))*DZC(K+2) - & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) - & +(B(L,K )-B(LS ,K ))*DZC(K ) - & +(B(L,K )-B(LS ,K ))*DZC(K ) ) - & -0.5*(B(L,K+2)-B(L,K+1)+B(LS ,K+2)-B(LS ,K+1))* - & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) - & -0.5*(B(L,K )-B(L,K )+B(LS ,K )-B(LS ,K ))* - & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) - ENDDO -C - IF(KC.GT.2)THEN - K=KS - DO L=2,LA - LS=LSC(L) - FBBX(L,K)=SBX(L)*GP*HU(L)* - & ( 0.5*HU(L)*( (B(L,K+1)-B(L-1,K+1))*DZC(K+1) - & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) - & +(B(L,K )-B(L-1,K ))*DZC(K ) - & +(B(L,K-1)-B(L-1,K-1))*DZC(K-1) ) - & -0.5*(B(L,K+1)-B(L,K+1)+B(L-1,K+1)-B(L-1,K+1))* - & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) - & -0.5*(B(L,K )-B(L,K-1)+B(L-1,K )-B(L-1,K-1))* - & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) - FBBY(L,K)=ROLD*FBBY(L,K)+RNEW*SBY(L)*GP*HV(L)* - & ( 0.5*HV(L)*( (B(L,K+1)-B(LS ,K+1))*DZC(K+1) - & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) - & +(B(L,K )-B(LS ,K ))*DZC(K ) - & +(B(L,K-1)-B(LS ,K-1))*DZC(K-1) ) - & -0.5*(B(L,K+1)-B(L,K+1)+B(LS ,K+1)-B(LS ,K+1))* - & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) - & -0.5*(B(L,K )-B(L,K-1)+B(LS ,K )-B(LS ,K-1))* - & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) - ENDDO - ENDIF -C - IF(KC.GT.3)THEN - DO K=1,KS - DO L=2,LA - LS=LSC(L) - FBBX(L,K)=SBX(L)*GP*HU(L)* - & ( 0.5*HU(L)*( (B(L,K+2)-B(L-1,K+2))*DZC(K+2) - & +(B(L,K+1)-B(L-1,K+1))*DZC(K+1) - & +(B(L,K )-B(L-1,K ))*DZC(K ) - & +(B(L,K-1)-B(L-1,K-1))*DZC(K-1) ) - & -0.5*(B(L,K+2)-B(L,K+1)+B(L-1,K+2)-B(L-1,K+1))* - & (BELV(L)-BELV(L-1)+Z(K+1)*(HP(L)-HP(L-1))) - & -0.5*(B(L,K )-B(L,K-1)+B(L-1,K )-B(L-1,K-1))* - & (BELV(L)-BELV(L-1)+Z(K-1)*(HP(L)-HP(L-1))) ) - FBBY(L,K)=ROLD*FBBY(L,K)+RNEW*SBY(L)*GP*HV(L)* - & ( 0.5*HV(L)*( (B(L,K+2)-B(LS ,K+2))*DZC(K+2) - & +(B(L,K+1)-B(LS ,K+1))*DZC(K+1) - & +(B(L,K )-B(LS ,K ))*DZC(K ) - & +(B(L,K-1)-B(LS ,K-1))*DZC(K-1) ) - & -0.5*(B(L,K+2)-B(L,K+1)+B(LS ,K+2)-B(LS ,K+1))* - & (BELV(L)-BELV(LS)+Z(K+1)*(HP(L)-HP(LS))) - & -0.5*(B(L,K )-B(L,K-1)+B(LS ,K )-B(LS ,K-1))* - & (BELV(L)-BELV(LS )+Z(K-1)*(HP(L)-HP(LS ))) ) - ENDDO - ENDDO - ENDIF -C - ENDIF -C -C FINITE VOLUME -C - IF(IINTPG.EQ.2)THEN -C - DO K=1,KS - DO L=2,LA - LS=LSC(L) - FBBX(L,K)=SBX(L)*GP*HU(L)* - & ( ( HP(L)*B(L,K+1)-HP(L-1)*B(L-1,K+1) )*DZC(K+1) - & +( HP(L)*B(L,K )-HP(L-1)*B(L-1,K ) )*DZC(K ) ) - & -RNEW*SBX(L)*GP*(BELV(L)-BELV(L-1))* - & ( HP(L)*B(L,K+1)-HP(L)*B(L,K) - & +HP(L-1)*B(L-1,K+1)-HP(L-1)*B(L-1,K) ) - & -RNEW*SBX(L)*GP*(HP(L)-HP(L-1))* - & ( HP(L)*ZZ(K+1)*B(L,K+1)-HP(L)*ZZ(K)*B(L,K) - & +HP(L-1)*ZZ(K+1)*B(L-1,K+1)-HP(L-1)*ZZ(K)*B(L-1,K) ) - FBBY(L,K)=SBY(L)*GP*HV(L)* - & ( ( HP(L)*B(L,K+1)-HP(LS )*B(LS ,K+1) )*DZC(K+1) - & +( HP(L)*B(L,K )-HP(LS )*B(LS ,K ) )*DZC(K ) ) - & -RNEW*SBY(L)*GP*(BELV(L)-BELV(LS ))* - & ( HP(L)*B(L,K+1)-HP(L)*B(L,K) - & +HP(LS)*B(LS ,K+1)-HP(LS)*B(LS ,K) ) - & -RNEW*SBY(L)*GP*(HP(L)-HP(LS ))* - & ( HP(L)*ZZ(K+1)*B(L,K+1)-HP(L)*ZZ(K)*B(L,K) - & +HP(LS)*ZZ(K+1)*B(LS ,K+1)-HP(LS)*ZZ(K)*B(LS ,K) ) - ENDDO - ENDDO -C - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 41---->',t03*1.e3,nthds - ENDIF ! *** END OF BOUYANCY -C -C IF(N.EQ.1)THEN -C OPEN(1,FILE='BUOY.DIA',STATUS='UNKNOWN') -C DO L=2,LA -C DO K=1,KS -C TMP3D(K)=SUBO(L)*FBBX(L,K) -C ENDDO -C WRITE(1,1111)IL(L),JL(L),(TMP3D(K),K=1,KS) -C DO K=1,KS -C TMP3D(K)=SVBO(L)*FBBY(L,K) -C ENDDO -C WRITE(1,1111)IL(L),JL(L),(TMP3D(K),K=1,KS) -C ENDDO -C CLOSE(1) -C ENDIF -C -C 1111 FORMAT(2I5,2X,8E12.4) -C -C**********************************************************************C -C -C ** CALCULATE EXPLICIT INTERNAL U AND V SHEAR EQUATION TERMS -C -C----------------------------------------------------------------------C -C - IF(KC.GT.1)THEN - L=1 - DU(L,KC)=0.0 - DV(L,KC)=0.0 - L=LC - DU(L,KC)=0.0 - DV(L,KC)=0.0 - ENDIF - IF(KC.GT.1)THEN - DO K=1,KS - RCDZF=CDZF(K) - DO L=2,LA - !DXYIU(L)=1./(DXU(L)*DYU(L)) - DU(L,K)=RCDZF*( HU(L)*(U(L,K+1)-U(L,K))*DELTI - & +DXYIU(L)*(FCAX(L,K+1)-FCAX(L,K)+FBBX(L,K) - & +SNLT*(FX(L,K)-FX(L,K+1))) ) - DV(L,K)=RCDZF*( HV(L)*(V(L,K+1)-V(L,K))*DELTI - & +DXYIV(L)*(FCAY(L,K)-FCAY(L,K+1)+FBBY(L,K) - & +SNLT*(FY(L,K)-FY(L,K+1))) ) - ENDDO - ENDDO - ENDIF -C -C IF(ISTL.EQ.2)THEN -C - IF(NWSER.GT.0)THEN - DO L=2,LA - DU(L,KS)=DU(L,KS)-CDZU(KS)*TSX(L) - DV(L,KS)=DV(L,KS)-CDZU(KS)*TSY(L) - ENDDO - ENDIF -c t03=rtc()-t02 -c write(6,*) 'Timing 4----->',t03*1.e3,nthds -C -C ENDIF -C -C**********************************************************************C -C -C IF(N.LE.4)THEN -C CLOSE(1) -C ENDIF -C - 1112 FORMAT('N,NW,NS,I,J,K,NF,H,Q,QU,FUU,FVV=',/,2X,7I5,5E12.4) -C -C**********************************************************************C -C - RETURN - END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index 637b53e95..e509355e2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -645,13 +645,9 @@ C ** CALCULATE EXPLICIT MOMENTUM EQUATION TERMS C T1TMP=SECNDS(0.0) c IF(IS2TIM.EQ.1) CALL CALEXP2T - IF(IS2TIM.EQ.1) THEN - IF(IDRYTBP.EQ.0)THEN - CALL CALEXP2T0 - ELSE - CALL CALEXP2T - ENDIF - ENDIF + IF(IS2TIM.EQ.1.AND.N.EQ.1) PRINT*, 'RUN CALEXP2T' + IF(IS2TIM.EQ.2.AND.N.EQ.1) PRINT*, 'RUN CALIMP2T' + IF(IS2TIM.EQ.1) CALL CALEXP2T IF(IS2TIM.EQ.2) CALL CALIMP2T TCEXP=TCEXP+T1TMP-SECOND() C @@ -759,6 +755,23 @@ C SNDBT(L,K)=0. ENDDO ENDDO +C + DO NS=1,NSED + DO K=1,KB + DO L=1,LC + SEDBT(L,K)=SEDBT(L,K)+SEDB(L,K,NS) + ENDDO + ENDDO + ENDDO +C + DO NS=1,NSND + DO K=1,KB + DO L=1,LC + SNDBT(L,K)=SNDBT(L,K)+SNDB(L,K,NS) + ENDDO + ENDDO + ENDDO +C DO K=1,KC DO L=1,LC SEDT(L,K)=0. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile index f32dfb625..f98c135fb 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile @@ -42,7 +42,7 @@ CGATEFLX.o RWQC1.o \ ACON.o CALEXP.o CALTSXY.o READWIMS1.o WQSKE4.o GATECTLREAD.o SCANEFDC.o \ VELPLTH.o DRIFTER.o SURFPLT.o WINDWAVE.o s_sedzlj.o EEXPOUT.o RESTOUT.o \ WQ3D.o s_shear.o CALHEAT.o CALPUVTT.o VARZEROReal.o \ -BAL2T5.o READOIL.o CALEXP2T0.o \ +BAL2T5.o READOIL.o \ AINIT.o CALEXP2T.o CALUVW.o DUMP.o READWIMS2.o SCANGATECTL.o SVBKSB.o WQZERO.o \ BAL2T1.o CALFQC.o CALVEGSER.o RELAX2T.o SCANGSER.o SVDCMP.o WQZERO2.o \ BAL2T2.o CALHDMF.o CALWQC.o RESTIN1.o SCANGWSR.o TIMELOG.o WQZERO3.o \ diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile.aix b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile.aix index da24926da..76ee61e71 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile.aix +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile.aix @@ -30,7 +30,7 @@ OBJECTS = \ ACON.o CALEXP.o CALTSXY.o READWIMS1.o WQSKE4.o GATECTLREAD.o SCANEFDC.o \ VELPLTH.o DRIFTER.o SURFPLT.o WINDWAVE.o s_sedzlj.o EEXPOUT.o RESTOUT.o \ WQ3D.o s_shear.o CALHEAT.o CALPUVTT.o VARZEROReal.o \ -BAL2T5.o READOIL.o CALEXP2T0.o \ +BAL2T5.o READOIL.o \ AINIT.o CALEXP2T.o CALUVW.o DUMP.o READWIMS2.o SCANGATECTL.o SVBKSB.o WQZERO.o \ BAL2T1.o CALFQC.o CALVEGSER.o RELAX2T.o SCANGSER.o SVDCMP.o WQZERO2.o \ BAL2T2.o CALHDMF.o CALWQC.o RESTIN1.o SCANGWSR.o TIMELOG.o WQZERO3.o \ diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index 36bf8c59c..db0b25139 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -12,3 +12,9 @@ conflicts... Additionally, the array GKMULT seems not to have been initialized in all possible situations and could have been used uninitialized in some. These patches were not brought back to OpenDA. +* `HDMT2T.for`: The NIER source does not invoke `CALEXP2TO` any longer + and shows slightly modified if-statements to consider which subroutine + to call. This subroutine is also no longer present in the provided + sources. It has been decided to cherry-pick these line diffs and + remove the remaining source file corresponding to `CALEXP2TO` all + together. From e799bf64d7e87eab9237c2623f9b5e0e79f8ab81 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 17:53:02 +0100 Subject: [PATCH 27/77] Transfer missing loops to WQSKE3 * Add missing Green algae salinity tox loops * Converts .AND. to .OR. to be consistent with all other comparisons * Modify if-statement IWQFCB to check with zero --- .../original_efdc_files/README.md | 6 +++ .../original_efdc_files/WQSKE3.for | 44 +++++++++---------- 2 files changed, 28 insertions(+), 22 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index db0b25139..e54c51c4a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -18,3 +18,9 @@ conflicts... sources. It has been decided to cherry-pick these line diffs and remove the remaining source file corresponding to `CALEXP2TO` all together. +* `WQSKE3.for`: This includes the missing loops (2 chunks) regarding + "green algae salinity tox" from NIER towards OpenDA. Additionally, + this converts all comparisons in OpenDA of the form + `IF(LMASKDRY(L).AND.IWQM.GE.1)THEN` from `.AND.` to `.OR.` to be + consistent with all other comparisons done like this. Also, the + comparison `IF(IWQBEN.EQ.1)THEN` now compares to zero instead. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for index 62b957e9d..612372d90 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for @@ -774,7 +774,7 @@ C **** PARAM 01 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP @@ -899,7 +899,7 @@ C **** PARAM 02 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP @@ -995,7 +995,7 @@ C **** PARAM 03 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS GROWTH BASAL METAB PREDATION SETTLING TIME STEP @@ -1093,7 +1093,7 @@ C **** PARAM 04 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS HYDROLYSIS SETTLING @@ -1160,7 +1160,7 @@ C **** PARAM 05 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQC5 = - (WQKLPC(L)+WQLPSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQC5) @@ -1221,7 +1221,7 @@ C **** PARAM 06 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQD6 = - (WQKHR(L)+WQDENIT(L)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQD6) @@ -1280,7 +1280,7 @@ C **** PARAM 07 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQE7 = - (WQKRPP(L)+WQRPSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQE7) @@ -1346,7 +1346,7 @@ C **** PARAM 08 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQF8 = - (WQKLPP(L)+WQLPSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQF8) @@ -1412,7 +1412,7 @@ C **** PARAM 09 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = 1.0 / (1.0 + DTWQO2*WQKDOP(L)) WQA9C = (WQFPDC*WQBMC(L) + WQFPDP*WQPRC(L)) * WQVO(L,K,1) @@ -1462,7 +1462,7 @@ C **** PARAM 10 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQA10C=(WQFPIC*WQBMC(L)+WQFPIP*WQPRC(L)-WQPC(L)) & *WQVO(L,K,1) @@ -1542,7 +1542,7 @@ C **** PARAM 11 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQI11 = - (WQKRPN(L)+WQRPSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQI11) @@ -1611,7 +1611,7 @@ C **** PARAM 12 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQJ12 = - (WQKLPN(L)+WQLPSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQJ12) @@ -1680,7 +1680,7 @@ C **** PARAM 13 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = 1.0 / (1.0 + DTWQO2*WQKDON(L)) WQA13C=(WQFNDC*WQBMC(L)+WQFNDP*WQPRC(L))*WQANCC @@ -1734,7 +1734,7 @@ C **** PARAM 14 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS ATM DRY DEP LOADS VOLUMN @@ -1797,7 +1797,7 @@ C **** PARAM 15 DO L=2,LA IZ=IWQZMAP(L,K) !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} C C DEFINITIONS ATM DRY DEP LOADS VOLUMN @@ -1855,7 +1855,7 @@ C **** PARAM 16 IF(IWQSI.EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQM16 = - (WQKSUA(IWQT(L)) + WQBDSET(L,1)) WQKK(L) = 1.0 / (1.0 - DTWQO2*WQM16) @@ -1912,7 +1912,7 @@ C **** PARAM 17 IF(IWQSI.EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = (WQFSID*WQBMD(L) + WQFSIP*WQPRD(L) - WQPD(L)) & * WQASCD * WQVO(L,K,2) @@ -1974,7 +1974,7 @@ C **** PARAM 18 IF(ISTRWQ(18).EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = 1.0 / (1.0 - WQO18(L)) C @@ -2017,7 +2017,7 @@ C **** PARAM 19 IF(ISTRWQ(19).EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = 1.0 / (1.0 - DTWQO2*WQP19(L)) C @@ -2167,7 +2167,7 @@ C **** PARAM 20 IF(IWQSRP.EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQT20 = - DTWQO2*WQWSSET(L,1) WQKK(L) = 1.0 / (1.0 - WQT20) @@ -2204,7 +2204,7 @@ C **** PARAM 21 IF(IWQFCB.EQ.1)THEN DO L=2,LA !{GeoSR, YSSONG, WQ WET/DRY, 110915 - IF(LMASKDRY(L).AND.IWQM.GE.1)THEN + IF(LMASKDRY(L).OR.IWQM.GE.1)THEN !} WQKK(L) = WQTD2FCB(IWQT(L)) C @@ -2306,7 +2306,7 @@ C COUPLING TO SEDIMENT MODEL C: EVALUATE DEP. FLUX USING NEW VALUES CAUSE IMPLICIT SCHEME IS USED IN C SPM C - IF(IWQBEN.EQ.1)THEN + IF(IWQBEN.EQ.0)THEN DO L=2,LA IMWQZ = IWQZMAP(L,1) WQDFBC(L) = SCB(L)*WQWSC(IMWQZ)*WQV(L,1,1) From 194da9ef7747f8e207badd67b62d51e25e114f69 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 19:50:39 +0100 Subject: [PATCH 28/77] Initialise variables --- .../native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 index e40486a20..c03ea1f16 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 @@ -443,6 +443,7 @@ SUBROUTINE VARZEROInt !} GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. ISICE=0 !{GeoSR, 2015.01.15 JHLEE, NEGATIVE WATER TEMPERATURE PROBLEM ! x-species + NNN=0 IWQBENOX=0 TIME_NUM=0 IBIN_TYPE=0 From af6201effe6d164922a8392cf0a41c33a2349a26 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 19:54:56 +0100 Subject: [PATCH 29/77] Add note regarding CALAVBOLD mpi differences --- .../native/efdc_fortran_dll/original_efdc_files/README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index e54c51c4a..a54cb33b9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -24,3 +24,8 @@ conflicts... `IF(LMASKDRY(L).AND.IWQM.GE.1)THEN` from `.AND.` to `.OR.` to be consistent with all other comparisons done like this. Also, the comparison `IF(IWQBEN.EQ.1)THEN` now compares to zero instead. +* `CALAVBOLD_mpi.for`: It is noted that `CALAVBOLD_mpi` performs + calculations using `SQRT` while the corresponding non-MPI + implementation uses multiplication with `0.5`... It is unclear why + this difference exists. No action has been taken to unify these + computations. From fe3088f74b814d3a4c8f9dff21b51ae7145a0cae Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 20:01:51 +0100 Subject: [PATCH 30/77] Transition patches from NIER to VARINIT.for --- .../efdc_fortran_dll/original_efdc_files/README.md | 14 +++++++++----- .../original_efdc_files/VARINIT.for | 4 ++-- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index a54cb33b9..c7fd121fc 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -7,6 +7,11 @@ Each file corresponds with a single commit that introduced the patch for that file. Note, this might not have been the right way to resolve the conflicts... +* `CALAVBOLD_mpi.for`: It is noted that `CALAVBOLD_mpi` performs + calculations using `SQRT` while the corresponding non-MPI + implementation uses multiplication with `0.5`... It is unclear why + this difference exists. No action has been taken to unify these + computations. * `CGATEFLX.for`: The NIER source misses the fix introducing boolean `HUPG_HDWG_INITIALIZED` that was added in 2016 in OpenDA. Additionally, the array GKMULT seems not to have been initialized in @@ -18,14 +23,13 @@ conflicts... sources. It has been decided to cherry-pick these line diffs and remove the remaining source file corresponding to `CALEXP2TO` all together. +* `VARINIT.for`: The comparison for `NQCTYPM` has been changed from + `.EQ.` to `.GE`. This seems mostly used. Inspection of the input decks + does not give more hints to the proper use of these values. Also, + `LCMWQ` setting is updated to match NIER. * `WQSKE3.for`: This includes the missing loops (2 chunks) regarding "green algae salinity tox" from NIER towards OpenDA. Additionally, this converts all comparisons in OpenDA of the form `IF(LMASKDRY(L).AND.IWQM.GE.1)THEN` from `.AND.` to `.OR.` to be consistent with all other comparisons done like this. Also, the comparison `IF(IWQBEN.EQ.1)THEN` now compares to zero instead. -* `CALAVBOLD_mpi.for`: It is noted that `CALAVBOLD_mpi` performs - calculations using `SQRT` while the corresponding non-MPI - implementation uses multiplication with `0.5`... It is unclear why - this difference exists. No action has been taken to unify these - computations. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for index 13197069e..11a8b885b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for @@ -50,7 +50,7 @@ C GEOSR 2010.5.7 IF(NQCTL.GE.1 .AND. NQCTYP1.GE.3) THEN CALL SCANGATECTL CALL SCANGSER ! GEOSR 2011.10.27 - IF(NQCTYPM .GE. 13) THEN + IF(NQCTYPM .eq. 13) THEN CALL SCANGTAB ! GEOSR 2014.09. UNG ENDIF ENDIF @@ -90,7 +90,7 @@ C IF(ISTRAN(8).GT.0)THEN LCMWQ=LCM ELSE - LCMWQ=1 + LCMWQ=LCM ENDIF NQINFLM=MAX(1,NQSIJ+NQCTL+NQWR+2*MDCHH) C From a5227079431c3a6d971f04e9b0e1e4c52a958695 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Wed, 13 Dec 2023 14:33:22 +0100 Subject: [PATCH 31/77] Setting NQCTYPM to EQ needs to be reverted? 7b484cc4eeaa2a42249129978b0950dd78c49ffc --- .../native/efdc_fortran_dll/original_efdc_files/VARINIT.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for index 11a8b885b..2ba28a9ff 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for @@ -50,7 +50,7 @@ C GEOSR 2010.5.7 IF(NQCTL.GE.1 .AND. NQCTYP1.GE.3) THEN CALL SCANGATECTL CALL SCANGSER ! GEOSR 2011.10.27 - IF(NQCTYPM .eq. 13) THEN + IF(NQCTYPM .ge. 13) THEN CALL SCANGTAB ! GEOSR 2014.09. UNG ENDIF ENDIF From 969ab021cd3600aa6724c373935cdbb7b70141b8 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 20:06:51 +0100 Subject: [PATCH 32/77] Add note on missing patch WQ3D.for in NIER --- .../native/efdc_fortran_dll/original_efdc_files/README.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index c7fd121fc..ead190e77 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -27,6 +27,10 @@ conflicts... `.EQ.` to `.GE`. This seems mostly used. Inspection of the input decks does not give more hints to the proper use of these values. Also, `LCMWQ` setting is updated to match NIER. +* `WQ3D.for`: The version in OpenDA also considered `TASER` values in + the condition for the various while-loops and other statements. The + decision was made that the version in OpenDA is accurate and the + patches are to be propagated back to NIER. * `WQSKE3.for`: This includes the missing loops (2 chunks) regarding "green algae salinity tox" from NIER towards OpenDA. Additionally, this converts all comparisons in OpenDA of the form From 0ca3bfa877ec45273a8ee8c862d2ccc6733fe928 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 20:11:10 +0100 Subject: [PATCH 33/77] Include missing patch for maybe new variables --- .../original_efdc_files/README.md | 5 ++++ .../original_efdc_files/RWQBEN2.for | 27 ++++++++++++++----- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index ead190e77..3c8bac049 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -23,6 +23,11 @@ conflicts... sources. It has been decided to cherry-pick these line diffs and remove the remaining source file corresponding to `CALEXP2TO` all together. +* `RWQBEN2.for`: There seemed to be a patch missing in OpenDA. The NIER + version is taken for this file where a slightly different (possibly + renamed) set of variables are used to extract properties from cards. + These seem to be reassigned at previously used variables elsewhere in + the source. * `VARINIT.for`: The comparison for `NQCTYPM` has been changed from `.EQ.` to `.GE`. This seems mostly used. Inspection of the input decks does not give more hints to the proper use of these values. Also, diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for index ebd613886..bc062844c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for @@ -103,13 +103,28 @@ C DO L=2,LA IZM = IBENMAP(L,1) IZS = IBENMAP(L,2) + IF(IWQBENOX.NE.0) IZA = IBENMAP(L,3) !{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 XM = XBENMUD(L) - WQBFPO4D(L) = XM*XBFPO4D(IZM) + (1.0-XM)*XBFPO4D(IZS) - WQBFNH4(L) = XM*XBFNH4(IZM) + (1.0-XM)*XBFNH4(IZS) - WQBFNO3(L) = XM*XBFNO3(IZM) + (1.0-XM)*XBFNO3(IZS) - WQBFSAD(L) = XM*XBFSAD(IZM) + (1.0-XM)*XBFSAD(IZS) - WQBFCOD(L) = XM*XBFCOD(IZM) + (1.0-XM)*XBFCOD(IZS) - WQBFO2(L) = XM*XBFO2(IZM) + (1.0-XM)*XBFO2(IZS) +C WQBFPO4D(L) = XM*XBFPO4D(IZM) + (1.0-XM)*XBFPO4D(IZS) !{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 +C WQBFNH4(L) = XM*XBFNH4(IZM) + (1.0-XM)*XBFNH4(IZS) +C WQBFNO3(L) = XM*XBFNO3(IZM) + (1.0-XM)*XBFNO3(IZS) +C WQBFSAD(L) = XM*XBFSAD(IZM) + (1.0-XM)*XBFSAD(IZS) +C WQBFCOD(L) = XM*XBFCOD(IZM) + (1.0-XM)*XBFCOD(IZS) +C WQBFO2(L) = XM*XBFO2(IZM) + (1.0-XM)*XBFO2(IZS) + WQBFOXPO4D(L,1) = XM*XBFPO4D(IZM) + (1.0-XM)*XBFPO4D(IZS) !{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 + WQBFOXNH4(L,1) = XM*XBFNH4(IZM) + (1.0-XM)*XBFNH4(IZS) + WQBFOXNO3(L,1) = XM*XBFNO3(IZM) + (1.0-XM)*XBFNO3(IZS) + WQBFOXSAD(L,1) = XM*XBFSAD(IZM) + (1.0-XM)*XBFSAD(IZS) + WQBFOXCOD(L,1) = XM*XBFCOD(IZM) + (1.0-XM)*XBFCOD(IZS) + WQBFOXO2(L,1) = XM*XBFO2(IZM) + (1.0-XM)*XBFO2(IZS) + IF(IWQBENOX.NE.0)THEN + WQBFOXPO4D(L,2) = XBFPO4D(IZA) + WQBFOXNH4(L,2) = XBFNH4(IZA) + WQBFOXNO3(L,2) = XBFNO3(IZA) + WQBFOXSAD(L,2) = XBFSAD(IZA) + WQBFOXCOD(L,2) = XBFCOD(IZA) + WQBFOXO2(L,2) = XBFO2(IZA) + ENDIF ENDDO CLOSE(1) CLOSE(2) From fed30eb10ffb375775f0906991a833de47d8e0d4 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 20:15:22 +0100 Subject: [PATCH 34/77] Scale variable initialisation with loop bound --- .../native/efdc_fortran_dll/original_efdc_files/README.md | 5 +++++ .../efdc_fortran_dll/original_efdc_files/READWIMS1.for | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index 3c8bac049..07175cce6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -23,6 +23,11 @@ conflicts... sources. It has been decided to cherry-pick these line diffs and remove the remaining source file corresponding to `CALEXP2TO` all together. +* `READWIMS1.for`: It seems the variable initialisation was not divided + by the loop limit. This has been reintroduced. Note, there were + differences in various timing calculations. These are considered to be + the right ones in OpenDA. The differences are to be propagated back to + NIER. * `RWQBEN2.for`: There seemed to be a patch missing in OpenDA. The NIER version is taken for this file where a slightly different (possibly renamed) set of variables are used to extract properties from cards. diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index 8885239ea..c87a6ec1c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -97,7 +97,7 @@ C OPEN(21,FILE='TXSER.INP',STATUS='UNKNOWN') DO K=1,KC - TXMASS_3D(K)=TXLDC + TXMASS_3D(K)=TXLDC/FLOAT(KC) TXMASS0(K)=0.0 ENDDO From 3eb937e80fa43b489dc756f023fabd75fed8ac29 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 20:47:06 +0100 Subject: [PATCH 35/77] Add WINDCOEFF and EFDC2 input card processing --- .../original_efdc_files/INPUT.for | 45 ++++++++++++------- .../original_efdc_files/README.md | 7 +++ 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index 01d67d425..0633f08ce 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -31,6 +31,7 @@ C CHARACTER*3 NCARD CHARACTER CCMRM*1, ADUMMY*5 ! EJH LOGICAL PARSE_LOGICAL, status + LOGICAL lwd, le2 REAL,ALLOCATABLE,DIMENSION(:)::RMULADS REAL,ALLOCATABLE,DIMENSION(:)::ADDADS INTEGER IPMC @@ -1909,6 +1910,15 @@ C 22 FORMAT (A80) 23 FORMAT (1X,A80) C +!{ GEOSR, Check file WINDCOEFF.INP exist jgcho 2016.10.21 + inquire (file='WINDCOEFF.INP', exist = lwd) + if(.not.lwd) then ! Not exist + ISWIND=0 + goto 9883 + else + ISWIND=1 + endif +!} GEOSR, Check file WINDCOEFF.INP exist jgcho 2016.10.21 !{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. IF(ISWIND.EQ.1)THEN PRINT *,'READING WINDCOEFF.INP' @@ -4632,28 +4642,29 @@ C goto 3000 endif - PRINT *,'READING THE extra EFDC CONTROL FILE: EFDC2.INP' - OPEN(1,FILE='EFDC2.INP',STATUS='UNKNOWN') -C + IF(MYRANK.EQ.0) PRINT *,'READING THE extra EFDC + & CONTROL FILE: EFDC2.INP' + OPEN(1,FILE='EFDC2.INP',STATUS='UNKNOWN') +C C1** READ TITLE CARD - NCARD='1' - CALL SEEK('C1') + NCARD='1' + CALL SEEK('C1') READ(1,*,IOSTAT=ISO) ISICE - WRITE(7,4002)NCARD - WRITE(7,*) ISICE - IF(ISO.GT.0) GOTO 400 - - CLOSE(1) + IF(MYRANK.EQ.0) WRITE(7,4002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) ISICE + IF(ISO.GT.0) GOTO 400 + + CLOSE(1) goto 3000 - 400 WRITE(6,4001)NCARD - WRITE(8,4001)NCARD - WRITE(7,4001)NCARD - 4001 FORMAT(/,'READ ERROR FROM FILE EFDC2.INP ON CARD ',A3/) - 4002 FORMAT(/,'INPUT ECHO NCARD = ',A/) - STOP + 400 WRITE(6,4001)NCARD + IF(MYRANK.EQ.0) WRITE(8,4001)NCARD + IF(MYRANK.EQ.0) WRITE(7,4001)NCARD + 4001 FORMAT(/,'READ ERROR FROM FILE EFDC2.INP ON CARD ',A3/) + 4002 FORMAT(/,'INPUT ECHO NCARD = ',A/) + STOP !} GEOSR, Check file EFDC2.INP read jgcho 2016.10.21 - + GOTO 3000 C C ** WRITE READ ERROR FOR OTHER INPUT FILES AND TERMINATE RUN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index 07175cce6..15de5ef3b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -23,6 +23,13 @@ conflicts... sources. It has been decided to cherry-pick these line diffs and remove the remaining source file corresponding to `CALEXP2TO` all together. +* `INPUT.for`: Input processing is extended with processing of + `WINDCOEFF` and `EFDC2` input files. It is unclear why this was not + yet present in OpenDA? Also, `IBIN_TYPE` is extracted with read calls. + NOTE: variable `TIDAPL` is *not* scaled with 86400 in OpenDA while + this is done in NIER. This seems to be a difference in conversion + factors of one day (86400 seconds in one day). It is unclear where + this difference comes from and how to resolve it... * `READWIMS1.for`: It seems the variable initialisation was not divided by the loop limit. This has been reintroduced. Note, there were differences in various timing calculations. These are considered to be From 622b0df47e9ea3bcb73ef3fa5cce8ed0962192a5 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 4 Dec 2023 21:08:41 +0100 Subject: [PATCH 36/77] Make CALPUV2C consistent with NIER --- .../original_efdc_files/CALPUV2C.for | 37 +++++-------------- .../original_efdc_files/README.md | 6 +++ 2 files changed, 15 insertions(+), 28 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for index 64d48bf3f..bfabd6b27 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for @@ -283,13 +283,13 @@ C ELSE QSUMTMP(L)=QSUME(L) ENDIF - DIFQVOL(L)=QSUME(L)-QSUMTMP(L) - QSUME(L)=QSUMTMP(L) ENDDO + DO L=2,LA + DIFQVOL=QSUME(L)-QSUMTMP(L) DO K=1,KC - DO L=2,LA QSUM(L,K)=QSUM(L,K)-DIFQVOL(L)*DZC(K) ENDDO + QSUME(L)=QSUMTMP(L) ENDDO ENDIF C @@ -357,13 +357,13 @@ C EVAPSW(L)=0. QSUMTMP(L)=MAX(QSUME(L),0.0) ENDIF - DIFQVOL(L)=QSUME(L)-QSUMTMP(L) - QSUME(L)=QSUMTMP(L) ENDDO DO L=2,LA + DIFQVOL=QSUME(L)-QSUMTMP(L) DO K=1,KC QSUM(L,K)=QSUM(L,K)-DIFQVOL(L)*DZC(K) ENDDO + QSUME(L)=QSUMTMP(L) ENDDO ENDIF C @@ -707,38 +707,19 @@ C IF(HP(L).LE.HDRY)THEN IF(ISCDRY(L).EQ.0)THEN ISCDRY(L)=1 - ICORDRY=ICORDRY+1 + ICORDRY=1 ENDIF SUB(L)=0. SVB(L)=0. - SBX(L)=0. - SBY(L)=0. SUB(L+1)=0. - SBX(L+1)=0. - ENDIF - ENDDO - L=LL - IF(HP(L).LE.HDRY)THEN - IF(ISCDRY(L).EQ.0)THEN - ISCDRY(L)=1 - ICORDRY=ICORDRY+1 - ENDIF - SUB(L)=0. - SVB(L)=0. + SVB(LN)=0. SBX(L)=0. SBY(L)=0. - SUB(L+1)=0. SBX(L+1)=0. - ENDIF - - DO L=2,LA - IF(HP(L).LE.HDRY)THEN - LN=LNC(L) - IF(SVB(LN).NE.0.) SVB(LN)=0. - IF(SBY(LN).NE.0.) SBY(LN)=0. + SBY(LN)=0. ENDIF ENDDO - IF(ICORDRY.GT.0)THEN + IF(ICORDRY.EQ.1)THEN NCORDRY=NCORDRY+1 GOTO 1000 ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md index 15de5ef3b..f1314a3d8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/README.md @@ -12,6 +12,12 @@ conflicts... implementation uses multiplication with `0.5`... It is unclear why this difference exists. No action has been taken to unify these computations. +* `CALPUV2C.for`: The diffs contain some odd instructions in the loops + present in the OpenDA version. It has been decided to accept the + patches from NIER here and adopt that variant of the implementation. + Similarly, the assignment of `ICORDRY=1` is replaced with the NIER + alternative of `ICORDRY=ICORDRY+1`. It is not clear why these + differences exist and which might be the proper one... * `CGATEFLX.for`: The NIER source misses the fix introducing boolean `HUPG_HDWG_INITIALIZED` that was added in 2016 in OpenDA. Additionally, the array GKMULT seems not to have been initialized in From b7240605a93681f286894cf8fd76b1a8b7849105 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 5 Dec 2023 14:55:43 +0100 Subject: [PATCH 37/77] Introduce remaining MPI related patches This introduces the MPI patches present in the original Fortran source files, such as including the MPI module and various occurances of checking the current rank through MYRANK, mostly to guard read, write, or debug statements. --- .../original_efdc_files/AINIT.for | 3 + .../original_efdc_files/BAL2T3B.for | 3 +- .../original_efdc_files/BAL2T5.for | 3 + .../original_efdc_files/BEDINIT.for | 5 +- .../original_efdc_files/BEDPLTH.for | 5 +- .../original_efdc_files/BUDGET5.for | 3 +- .../original_efdc_files/CALBAL5.for | 3 + .../original_efdc_files/CALDISP2.for | 3 + .../original_efdc_files/CALDISP3.for | 5 + .../original_efdc_files/CALHTA.for | 5 + .../original_efdc_files/CALSED.for | 3 + .../original_efdc_files/CALSND.for | 3 +- .../original_efdc_files/CALSTEP.for | 5 +- .../original_efdc_files/CALSTEPD.for | 5 +- .../original_efdc_files/CALTOX.for | 3 +- .../original_efdc_files/CELLMAP.for | 11 +- .../original_efdc_files/CEQICM.for | 9 +- .../original_efdc_files/CGATEFLX.for | 7 +- .../original_efdc_files/DEPPLT.for | 4 + .../original_efdc_files/DUMP.for | 83 +-- .../original_efdc_files/GATECTLREAD.for | 49 +- .../original_efdc_files/HDMT2T.for | 215 +++++- .../original_efdc_files/INITBIN3.for | 5 +- .../original_efdc_files/INPUT.for | 523 +++++++++++---- .../original_efdc_files/JPEFDC.for | 36 +- .../original_efdc_files/LSQHARM.for | 5 + .../original_efdc_files/Makefile | 2 +- .../original_efdc_files/NEGDEP.for | 3 + .../original_efdc_files/OUT3D.for | 3 + .../original_efdc_files/OUTOIL.for | 5 +- .../original_efdc_files/OUTPUT2.for | 7 +- .../original_efdc_files/PPLOT.for | 11 +- .../original_efdc_files/RCAHQ.for | 3 + .../original_efdc_files/READWIMS1.for | 8 +- .../original_efdc_files/RELAX2T.for | 3 +- .../original_efdc_files/RESTIN1.for | 13 +- .../original_efdc_files/RESTIN10.for | 3 +- .../original_efdc_files/RESTIN2.for | 3 +- .../original_efdc_files/RESTOUT.for | 454 ++++++++++++- .../original_efdc_files/ROUT3D.for | 4 + .../original_efdc_files/RSALPLTH.for | 3 + .../original_efdc_files/RSALPLTV.for | 3 + .../original_efdc_files/RSMICI.for | 19 +- .../original_efdc_files/RSMRST.for | 5 +- .../original_efdc_files/RSURFPLT.for | 3 + .../original_efdc_files/RVELPLTH.for | 5 + .../original_efdc_files/RVELPLTV.for | 3 + .../original_efdc_files/RWQAGR.for | 33 +- .../original_efdc_files/RWQATM.for | 3 + .../original_efdc_files/RWQBEN2.for | 31 +- .../original_efdc_files/RWQC1.for | 628 ++++++++++++++---- .../original_efdc_files/RWQCSR.for | 10 +- .../original_efdc_files/RWQICI.for | 15 +- .../original_efdc_files/RWQPSL.for | 12 +- .../original_efdc_files/RWQRST.for | 7 +- .../original_efdc_files/RWQSTL.for | 21 +- .../original_efdc_files/RWQSUN.for | 5 +- .../original_efdc_files/SCANASER.for | 16 +- .../original_efdc_files/SCANDSER.for | 13 +- .../original_efdc_files/SCANEFDC.for | 17 +- .../original_efdc_files/SCANGATECTL.for | 10 +- .../original_efdc_files/SCANGSER.for | 10 +- .../original_efdc_files/SCANGTAB.for | 5 +- .../original_efdc_files/SCANGWSR.for | 13 +- .../original_efdc_files/SCANMASK.for | 8 +- .../original_efdc_files/SCANMODC.for | 13 +- .../original_efdc_files/SCANPSER.for | 13 +- .../original_efdc_files/SCANQCTL.for | 10 +- .../original_efdc_files/SCANQSER.for | 29 +- .../original_efdc_files/SCANSEDZLJ.f90 | 19 +- .../original_efdc_files/SCANSFSR.for | 13 +- .../original_efdc_files/SCANSSER.for | 13 +- .../original_efdc_files/SCANTSER.for | 13 +- .../original_efdc_files/SCANWQ.for | 7 +- .../original_efdc_files/SCANWSER.for | 13 +- .../original_efdc_files/SCNTXSED.for | 22 +- .../original_efdc_files/SEEK.for | 5 +- .../original_efdc_files/SHOWVAL.f90 | 4 +- .../original_efdc_files/SMRIN1.for | 126 ++-- .../original_efdc_files/SSEDTOX.for | 7 +- .../original_efdc_files/SUBCHAN.for | 3 +- .../original_efdc_files/SURFPLT.for | 6 +- .../original_efdc_files/TMSR.for | 71 +- .../original_efdc_files/VALKH.for | 3 +- .../original_efdc_files/VARZEROInt.f90 | 3 +- .../original_efdc_files/VARZEROReal.f90 | 3 +- .../original_efdc_files/WAVEBL.for | 17 +- .../original_efdc_files/WQ3DINP.for | 21 +- .../original_efdc_files/WQSKE3.for | 22 +- .../original_efdc_files/WQSKE4.for | 18 +- .../original_efdc_files/WWQRST.for | 11 + .../original_efdc_files/WWQTS.for | 8 +- .../original_efdc_files/WWQTSBIN.for | 3 + .../original_efdc_files/foodchain.for | 7 +- .../original_efdc_files/initbin0.for | 5 +- .../original_efdc_files/initbin2.for | 5 +- 96 files changed, 2270 insertions(+), 667 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for index 47edbd09a..a9a804a82 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/AINIT.for @@ -9,6 +9,7 @@ C C ALL ZEROING OF ARRAYS MOVED TO ZERO C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::L,I,J,LS,NT,LCHNV,IVAL,NS,K,NMD,LHOST,LCHNU,NV,NX INTEGER::NTMPC,NTMPN @@ -116,6 +117,8 @@ C SDY(L)=1. LMASKDRY(L)=.TRUE. ENDDO + IF(.NOT.ALLOCATED(MPI_IMASKDRY)) ALLOCATE(MPI_IMASKDRY(LCM)) + C C *** DSLLC BEGIN BLOCK ! *** OPEN WATER DEFAULT SETTINGS diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for index 5ec4eb20a..ae4a4b4fc 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T3B.for @@ -8,6 +8,7 @@ C ** SUBROUTINES CALBAL CALCULATE GLOBAL VOLUME, MASS, MOMENTUM, C ** AND ENERGY BALANCES C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::LUTMP,LDTMP,L,K,NSX,NSB,IBALSTDT,NT,M IF(ISDYNSTP.EQ.0)THEN @@ -28,7 +29,7 @@ C IF(ISTRAN(5).GE.1)THEN DO NT=1,NTOX M=MSVTOX(NT) - WRITE(8,*)'NT M ',NT,M + IF(MYRANK.EQ.0) WRITE(8,*)'NT M ',NT,M DO K=1,KC DO L=2,LC CONT(L,K)=TOX(L,K,NT) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for index cd42a364a..39aede618 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BAL2T5.for @@ -23,6 +23,7 @@ C C**********************************************************************C C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::K,L,NS @@ -464,6 +465,7 @@ C ** OUTPUT BALANCE RESULTS TO FILE BAL2T.OUT C C----------------------------------------------------------------------C C + IF(MYRANK.EQ.0)THEN IF(JSBAL.EQ.1)THEN OPEN(89,FILE='BAL2T.OUT') CLOSE(89,STATUS='DELETE') @@ -731,6 +733,7 @@ C CLOSE(82) CLOSE(83) CLOSE(84) + ENDIF ! MYRANK0 C 8899 FORMAT(A18,E15.7) 950 FORMAT(I5,12E17.9) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDINIT.for index b56aece12..0051acc25 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDINIT.for @@ -7,6 +7,7 @@ C ADDED ADDITIONAL DIAGNOSTIC OUTPUT C MOVED TOXIC INITIALIZATIONS FROM SSEDTOX C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::K,L,NS,NX,NT,KTOPP1,IVAL,KTOPTP,IHOTSTRT @@ -1117,7 +1118,7 @@ C C C ** DIAGNOSTICS OF INITIALIZATION C - IF(ISDTXBUG.EQ.1)THEN + IF(ISDTXBUG.EQ.1.AND.MYRANK.EQ.0)THEN OPEN(2,FILE='TOXBED.DIA') CLOSE(2,STATUS='DELETE') OPEN(2,FILE='TOXBED.DIA') @@ -1251,7 +1252,7 @@ C C** WRITE DIAGNOSTIC FILES FOR BED INITIALIZATION C 1000 CONTINUE - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='BEDINIT.SED') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='BEDINIT.SED') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for index 7ea6c479e..8588aa606 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BEDPLTH.for @@ -6,6 +6,7 @@ C ADD OUTPUT OF BED LOAD TRANSPORT QSBDLDX QSBDLDY C ** SUBROUTINE WRITES SEDIMENT BED PROPERTIES C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::L,K,NX,NS,NSXD,KTMP REAL::TIME @@ -29,6 +30,7 @@ C 3 WRITE NONCOHESIVE SEDIMENT (FRACTION OF TOTAL SEDIMENT+ C ISBVDR: 1 WRITE LAYER VOID RATIOS C IF(JSBPH.EQ.1)THEN + IF(MYRANK.EQ.0)THEN IF(ISBEXP.EQ.0)THEN OPEN(1,FILE='BEDSUM.OUT') CLOSE(1,STATUS='DELETE') @@ -71,6 +73,7 @@ C OPEN(1,FILE='BEDARD.OUT') WRITE(1,131) CLOSE(1) + ENDIF JSBPH=0 ENDIF C @@ -84,7 +87,7 @@ C ENDIF NSXD=NSED+NSND C - IF(ISBEXP.EQ.0)THEN + IF(ISBEXP.EQ.0.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='BEDSUM.OUT',POSITION='APPEND') WRITE(1,122)TIME DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for index eac5ae220..877c407bc 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/BUDGET5.for @@ -5,6 +5,7 @@ C CHANGE RECORD C ** SUBROUTINES BUDGETN CALCULATE SEDIMENT BUDGET (TOTAL SEDIMENTS) C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::NS,L,K REAL::SEDBTMP1,SEDBTMP,SFLXTMP,BSEDERR,SSEDOUT,BSEDOUT,SSEDERE @@ -145,7 +146,7 @@ C C C ** OUTPUT BALANCE RESULTS TO FILE BUDGET.OUT C - IF(JSSBAL.EQ.1)THEN + IF(JSSBAL.EQ.1.AND.MYRANK.EQ.0)THEN OPEN(89,FILE='BUDGET.OUT',STATUS='UNKNOWN') OPEN(93,FILE='BUDGET2.OUT',STATUS='UNKNOWN') OPEN(94,FILE='BUDGET3.OUT',STATUS='UNKNOWN') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBAL5.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBAL5.for index 39d8e09c0..bdd3bee41 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBAL5.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALBAL5.for @@ -5,6 +5,7 @@ C ** SUBROUTINES CALBAL CALCULATE GLOBAL VOLUME, MASS, MOMENTUM, C ** AND ENERGY BALANCES C USE GLOBAL + USE MPI IMPLICIT NONE REAL::ENEEND,ENEOUT,VOLBMO,SALBMO,DYEBMO,UMOBMO,VMOBMO,ENEBMO REAL::VOLERR,SALERR,DYEERR,UMOERR,VMOERR,ENEERR,RVERDE,RSERDE @@ -105,6 +106,7 @@ C C C ** OUTPUT BALANCE RESULTS TO FILE BAL.OUT C + IF(MYRANK.EQ.0)THEN IF(JSBAL.EQ.1)THEN OPEN(89,FILE='BAL.OUT',STATUS='UNKNOWN') CLOSE(89,STATUS='DELETE') @@ -161,6 +163,7 @@ C WRITE(89,900) WRITE(89,899) CLOSE(89) + ENDIF 890 FORMAT (' VOLUME, MASS, AND ENERGY BALANCE OVER',I5,' TIME STEPS' & ,' ENDING AT TIME STEP',I5,//) 891 FORMAT (' INITIAL VOLUME INITIAL SALT INITIAL DYE ' diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP2.for index 1cffce13c..e5c4942ef 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP2.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::K,KK,KT,L,LN @@ -257,6 +258,7 @@ C C C ** WRITE OUTPUT FILES C + IF(MYRANK.EQ.0)THEN OPEN(88,FILE='DISTEN.OUT',STATUS='UNKNOWN') CLOSE(88,STATUS='DELETE') OPEN(88,FILE='DISTEN.OUT',STATUS='UNKNOWN') @@ -291,6 +293,7 @@ C WRITE(88,2013)IL(L),JL(L),(SVAL(K,L),K=1,KC) ENDDO CLOSE(88) + ENDIF 881 FORMAT(3X,'I',3X,'J',3X,'LON',9X,'LAT',9X,'DXX',10X,'DXY',10X, & 'DYX',10X,'DYY') 882 FORMAT(3X,'I',3X,'J',3X,'LON',9X,'LAT',9X,'AMCPT',8X,'AMSPT',8X, diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP3.for index 730728b21..aa161de4b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALDISP3.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::K,KK,L,LS,KT,LN @@ -236,6 +237,7 @@ C C C ** ADJUST DISPERSON TENSOR COMPONENTS C + IF(MYRANK.EQ.0)THEN OPEN(88,FILE='DISDIA.OUT',STATUS='UNKNOWN') CLOSE(88,STATUS='DELETE') OPEN(88,FILE='DISDIA.OUT',STATUS='UNKNOWN') @@ -429,6 +431,7 @@ C ENDIF ENDDO CLOSE(88) + ENDIF 8881 FORMAT(' I=',I5,2X,'J=',I5,2X,'DXX= ',E12.4) 8882 FORMAT(' I=',I5,2X,'J=',I5,2X,'DXY= ',E12.4) 8883 FORMAT(' I=',I5,2X,'J=',I5,2X,'DYX= ',E12.4) @@ -436,6 +439,7 @@ C C C ** WRITE OUTPUT FILES C + IF(MYRANK.EQ.0)THEN OPEN(88,FILE='DISTEN.OUT',STATUS='UNKNOWN') CLOSE(88,STATUS='DELETE') OPEN(88,FILE='DISTEN.OUT',STATUS='UNKNOWN') @@ -465,6 +469,7 @@ C & VELPF(L),SALLPF(L,1),SALLPF(L,KC) ENDDO CLOSE(88) + ENDIF 881 FORMAT(3X,'I',3X,'J',3X,'LON',9X,'LAT',9X,'DXX',10X,'DXY',10X, & 'DYX',10X,'DYY') 882 FORMAT(3X,'I',3X,'J',3X,'LON',9X,'LAT',9X,'AMCPT',8X,'AMSPT',8X, diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for index 04aaa0de0..18ee02bd6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALHTA PERFORMS A HARMONIC ANALYSIS FOR THE M2 TIDE C ** OVER TWO TIDAL CYCLES C USE GLOBAL + USE MPI CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE4,TITLE11,TITLE12 C C ** INITIALIZE ON FIRST ENTRY FOR CURRENT ANALYSIS INTERVAL @@ -26,6 +27,7 @@ C AMSV(L,K)=0. ENDDO ENDDO + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='SURFAMP.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='SURFAMP.OUT',STATUS='UNKNOWN') @@ -81,6 +83,7 @@ C WRITE (4,101)LINES,LEVELS WRITE (4,250)DBS1,DBS2 CLOSE(4) + ENDIF C C ** ACCUMULATE HARMONIC ANALYSIS C @@ -145,6 +148,7 @@ C ENDDO ENDDO NHAR=0 + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='SURFAMP.OUT',POSITION='APPEND',STATUS='UNKNOWN') WRITE (1,100)N OPEN(2,FILE='SURFPHA.OUT',POSITION='APPEND',STATUS='UNKNOWN') @@ -235,6 +239,7 @@ C CLOSE(4) CLOSE(11) CLOSE(12) + ENDIF 2000 CONTINUE NHAR=NHAR+1 99 FORMAT(A80) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for index e3d8da474..85d555859 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSED.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALSED CALCULATES COHESIVE SEDIMENT SETTLING, C ** DEPOSITION AND RESUSPENSION AND IS CALLED FOR SSEDTOX C USE GLOBAL + USE MPI C C**********************************************************************C C @@ -1053,6 +1054,7 @@ CDIAG 104 FORMAT(' N,NS,I,J,SEDBMN,SEDBSMN = ',4I5,4E13.4) CDIAG 105 FORMAT(' N,NS,I,J,SEDFMX,SEDFSMX = ',4I5,4E13.4) CDIAG 106 FORMAT(' N,NS,I,J,SEDFMN,SEDFSMN = ',4I5,4E13.4) C + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='NEGSEDSND.OUT',POSITION='APPEND') C DO NS=1,NSED @@ -1079,6 +1081,7 @@ C ENDDO C CLOSE(1) + ENDIF C C ** ACCUMULATE NET POSTIVE AND NEGATIVE COHESIVE SEDIMENT FLUXES C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for index 7195f1fec..ed67b6ae5 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSND.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALSND CALCULATES NONCOHESIVER SEDIMENT SETTLING, C ** DEPOSITION AND RESUSPENSION AND IS CALLED FOR SSEDTOX C USE GLOBAL + USE MPI IMPLICIT NONE REAL::TIME,GRADSED,SIGP,CRNUM,DUM1,DUM3,DUM4,DIASED3 @@ -1311,7 +1312,7 @@ C C C**********************************************************************C C - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN IFLAG=0 DO NS=1,NSND DO K=1,KC diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for index af0a523ad..b9981af93 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEP.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALSTEP ESTIMATE THE CURRENT MAXIMUM TIME STEP SIZE C ** FORM LINEAR STABILITY CRITERIA AND A FACTOR OF SAFETY C USE GLOBAL + USE MPI REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL1 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL2 @@ -147,7 +148,7 @@ C IF(BOT.GT.0.0)THEN DTTMP=TOP/BOT DTL2(L)=MIN(DTL2(L),DTTMP) - IF(DTTMP.LT.0.0)THEN + IF(DTTMP.LT.0.0.AND.MYRANK.EQ.0)THEN WRITE(6,880)IL(L),JL(L),K,TOP,QXPLUS,QYPLUS,QZPLUS, & QXMINS,QYMINS,QZMINS,QSRC WRITE(8,880)IL(L),JL(L),K,TOP,QXPLUS,QYPLUS,QZPLUS, @@ -236,6 +237,7 @@ C ** MAKE A MULTIPLE OF OF DTMIN C TIMEDAY=TIMESEC/86400. IF(DTCOMP.LT.DTMIN)THEN ! *** DSLLC SINGLE LINE + IF(MYRANK.EQ.0)THEN WRITE(8,800)TIMEDAY,DTTMP,DTMIN,IL(LLOC),JL(LLOC) WRITE(6,800)TIMEDAY,DTTMP,DTMIN,IL(LLOC),JL(LLOC) WRITE(8,801)IL(L1LOC),JL(L1LOC),DTL1MN @@ -244,6 +246,7 @@ C WRITE(6,802)IL(L2LOC),JL(L2LOC),DTL2MN WRITE(8,803)IL(L3LOC),JL(L3LOC),DTL3MN WRITE(6,803)IL(L3LOC),JL(L3LOC),DTL3MN + ENDIF DTTMP=DTMIN C *** DSLLC BEGIN BLOCK ELSEIF(DTTMP.LT.DTMIN)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for index 5c5bd0179..d7d85aef9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALSTEPD.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALSTEP ESTIMATE THE CURRENT MAXIMUM TIME STEP SIZE C ** FORM LINEAR STABILITY CRITERIA AND A FACTOR OF SAFETY C USE GLOBAL + USE MPI REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL1 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DTL2 @@ -156,7 +157,7 @@ C IF(BOT.GT.0.0)THEN DTTMP=TOP/BOT DTL2(L)=MIN(DTL2(L),DTTMP) - IF(DTTMP.LT.0.0)THEN + IF(DTTMP.LT.0.0.AND.MYRANK.EQ.0)THEN WRITE(6,880)IL(L),JL(L),K,TOP,QXPLUS,QYPLUS,QZPLUS, & QXMINS,QYMINS,QZMINS,QSRC WRITE(8,880)IL(L),JL(L),K,TOP,QXPLUS,QYPLUS,QZPLUS, @@ -253,6 +254,7 @@ c CACAMP=SQRT(1.+CACDTMX*CACDTMX) C TIMEDAY=TIMESEC/86400. IF(DTCOMP.LT.DTMIN)THEN ! *** DSLLC SINGLE LINE + IF(MYRANK.EQ.0)THEN WRITE(8,800)TIMEDAY,DTTMP,DTMIN,IL(LLOC),JL(LLOC) WRITE(6,800)TIMEDAY,DTTMP,DTMIN,IL(LLOC),JL(LLOC) WRITE(8,801)IL(L1LOC),JL(L1LOC),DTL1MN @@ -261,6 +263,7 @@ C WRITE(6,802)IL(L2LOC),JL(L2LOC),DTL2MN WRITE(8,803)IL(L3LOC),JL(L3LOC),DTL3MN WRITE(6,803)IL(L3LOC),JL(L3LOC),DTL3MN + ENDIF DTTMP=DTMIN C *** DSLLC BEGIN BLOCK ELSEIF(DTTMP.LT.DTMIN)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for index f52a57b8c..b9fb2570a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTOX.for @@ -5,6 +5,7 @@ C ** SUBROUTINE CALSND CALCULATES NONCOHESIVER SEDIMENT SETTLING, C ** DEPOSITION AND RESUSPENSION AND IS CALLED FOR SSEDTOX C USE GLOBAL + USE MPI REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TOXFPA IF(.NOT.ALLOCATED(TOXFPA))THEN @@ -560,7 +561,7 @@ C C ** DIAGNOSTICS OF FLUX C IF(ISDTXBUG.EQ.1.AND.DEBUG)THEN - IF(N.EQ.1)THEN + IF(N.EQ.1.AND.MYRANK.EQ.0)THEN OPEN(2,FILE='TOXFLX.DIA') CLOSE(2,STATUS='DELETE') OPEN(2,FILE='TOXFLX.DIA') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for index 1afaaab11..f797641b8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CELLMAP.for @@ -4,6 +4,7 @@ C ** SUBROUTINE CELLMAP GENERATES CELL MAPPINGS C CHANGE RECORD C USE GLOBAL + USE MPI C C ** SET 1D CELL INDEX SEQUENCE AND MAPPINGS C @@ -24,7 +25,7 @@ C IF(IJCT(I,J).EQ.9) WRITE(1,1616)I,J ENDDO LA=L-1 LCTT=L - IF(LCTT.NE.LC)THEN + IF(LCTT.NE.LC.AND.MYRANK.EQ.0)THEN WRITE(6,1617)LCTT,LC WRITE(7,1617)LCTT,LC WRITE(8,1617)LCTT,LC @@ -35,8 +36,8 @@ C IF(IJCT(I,J).EQ.9) WRITE(1,1616)I,J JL(1)=0 JL(LC)=0 c WRITE(1,601)LA - WRITE(7,601)LA - WRITE(8,601)LA + IF(MYRANK.EQ.0) WRITE(7,601)LA + IF(MYRANK.EQ.0) WRITE(8,601)LA c CLOSE(1) 601 FORMAT(' LA=',I10,//) 1616 FORMAT(2I10) @@ -74,8 +75,8 @@ c CLOSE(1) LALT=L-1 LCLT=L ENDIF - WRITE(7,1616)LALT,LCLT - WRITE(8,1616)LALT,LCLT + IF(MYRANK.EQ.0) WRITE(7,1616)LALT,LCLT + IF(MYRANK.EQ.0) WRITE(8,1616)LALT,LCLT C C ** ASSIGN RED AND BLACK CELL SEQUENCES (PMC - NOT FUNCTIONAL) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for index 1663f44e2..99fe7ed8a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CEQICM.for @@ -4,6 +4,7 @@ C CHANGE RECORD C ** SUBROUTINE FOR INTERFACING CE-QUAL-ICM MODEL C USE GLOBAL + USE MPI ! *** DSLLC REAL,ALLOCATABLE,DIMENSION(:)::QINRCA @@ -63,7 +64,7 @@ C C ** WRITE I,J INDICES DEFINING FLOWS BETWEEN ARBITARY CELLS C ** (POSTIVE FLOW DIRECTION DEFINED FROM FIRST TO SECOND I,J PAIR) C - IF(IAUXICM.GE.1)THEN + IF(IAUXICM.GE.1.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='FLWMAP.INP',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='FLWMAP.INP',STATUS='UNKNOWN') @@ -111,6 +112,7 @@ C C C ** WRITE EXTERNAL INFLOW LOCATIONS C + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='INFLOWIJ.DAT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='INFLOWIJ.DAT',STATUS='UNKNOWN') @@ -213,9 +215,11 @@ C ENDIF CLOSE(1) IF(ISDICM.EQ.1) CLOSE(2) + ENDIF C C ** INITIALIZE OTHER FILES TO RECEIVE TIME VARYING DATA C + IF(MYRANK.EQ.0)THEN IF(IAUXICM.EQ.1)THEN OPEN(1,FILE='INFLOW.DAT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') @@ -276,6 +280,7 @@ C WRITE(1,2006) WRITE(1,2007) CLOSE(1) + ENDIF JSWASP=0 RETURN 1000 CONTINUE @@ -294,6 +299,7 @@ C C C ** WRITE TIME AT END OF AVERAGING PERIOD TO EFDCICM.LOG C + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='EFDCICM.LOG',STATUS='UNKNOWN',POSITION='APPEND') WRITE(1,106)TIME WRITE(1,2008) @@ -722,6 +728,7 @@ C CLOSE(2) ENDIF ENDIF + ENDIF 100 FORMAT(120X) 101 FORMAT(4I10) 102 FORMAT(/,' NROW,NCOL,NLAYR = ',3I10/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for index 246b3fc45..9fabc0b94 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CGATEFLX.for @@ -7,6 +7,7 @@ C ** SUBROUTINE CGATEFLX C GATE CONTROL FLUX C USE GLOBAL + USE MPI implicit none integer:: I,K, LG, NCMP, NCTL, NS integer :: id, iu, jd, ju, ld, ldu, lu @@ -68,6 +69,8 @@ C IF (ISINK.EQ.1) THEN ! READY SINK#.OUT FSINK='SINK.OUT' + !IF(MYRANK.EQ.0.AND.DEBUG)THEN + IF(MYRANK.EQ.0)THEN OPEN(711,FILE=TRIM(FSINK),STATUS='UNKNOWN') ! OPEN OLD FILE CLOSE(711,STATUS='DELETE') ! DELETE OLD FILE OPEN(711,FILE=FSINK,STATUS='UNKNOWN') ! OPEN NEW FILE @@ -89,7 +92,7 @@ C write(713,FMTSTR) ' N TIME', & ((NS,'_K',k,k=1,KC),NS,'_O',00,NS=1,NQCTL) !} GEOSR GATE : jgcho 2016.07.14 - + ENDIF ISINK=2 ! READY TO WRITE SINK##.OUT SNKW=DTSNK*60./DT ! WRITING TIME INTERVAL @@ -1452,6 +1455,7 @@ C IF (ISINK.EQ.2) THEN IF (MOD(FLOAT(N),SNKW).EQ.0. .OR. DTSNK.EQ.-1.) THEN C + IF(MYRANK.EQ.0)THEN FSINK='SINK.OUT' OPEN(711,FILE=TRIM(FSINK),POSITION='APPEND') WRITE(FMTSTR, @@ -1479,6 +1483,7 @@ C & ,NS=1,NQCTL) CLOSE(713) + ENDIF ENDIF ! IF (MOD(FLOAT(N),SNKW).EQ.0.) THEN ENDIF ! IF (ISINK.EQ.2) THEN ! END: WRITE SINK.OUT diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for index 3401f62c9..8101c47c0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DEPPLT.for @@ -4,9 +4,11 @@ C ** SUBROUTINE DEPPLT WRITES A FILE TO CONTOUR PLOT DEPTH C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER*80 TITLE + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='BELVCON.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='BELVCON.OUT',STATUS='UNKNOWN') @@ -23,6 +25,8 @@ C WRITE(1,200)IL(L),JL(L),DLON(L),DLAT(L),BELV(L) ENDDO CLOSE(1) + ENDIF + 99 FORMAT(A80) 100 FORMAT(I10) C 101 FORMAT(2I10) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for index e460b0e50..2925fa320 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/DUMP.for @@ -5,6 +5,7 @@ C ** SUBROUTINE DUMP WRITES FULL FIELD DUMPS OF MODEL VARIABLES C ** AT SPECIFIED TIME INTERVALS C USE GLOBAL + USE MPI CHARACTER*1 CZTT(0:9) CHARACTER*1 CCHTMF,CCHTMS C @@ -166,7 +167,7 @@ C FNDTBP(NT)='TBP'// CNTTOX(NT) // 'DPF.BIN' ENDDO ENDIF - IF(ISADMP.EQ.0)THEN + IF(ISADMP.EQ.0.AND.MYRANK.EQ.0)THEN OPEN(1,FILE=FNDSEL) CLOSE(1,STATUS='DELETE') OPEN(1,FILE=FNDUUU) @@ -388,7 +389,7 @@ C C C ** WATER SURFACE ELEVATION C - IF(ISDMPP.GE.1)THEN + IF(ISDMPP.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSEL,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSEL,POSITION='APPEND',FORM='UNFORMATTED') @@ -413,7 +414,7 @@ C C C ** U VELOCITY COMPONENT C - IF(ISDMPU.GE.1)THEN + IF(ISDMPU.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDUUU,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDUUU,POSITION='APPEND',FORM='UNFORMATTED') @@ -443,7 +444,7 @@ C C C ** V VELOCITY COMPONENT C - IF(ISDMPU.GE.1)THEN + IF(ISDMPU.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDVVV,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDVVV,POSITION='APPEND',FORM='UNFORMATTED') @@ -473,7 +474,7 @@ C C C ** W VELOCITY COMPONENT C - IF(ISDMPW.GE.1)THEN + IF(ISDMPW.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDWWW,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDWWW,POSITION='APPEND',FORM='UNFORMATTED') @@ -503,7 +504,7 @@ C C C ** SALINITY C - IF(ISDMPT.GE.1.AND.ISTRAN(1).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(1).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSAL,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSAL,POSITION='APPEND',FORM='UNFORMATTED') @@ -532,7 +533,7 @@ C C C ** TEMPATURE C - IF(ISDMPT.GE.1.AND.ISTRAN(2).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(2).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTEM,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDTEM,POSITION='APPEND',FORM='UNFORMATTED') @@ -561,7 +562,7 @@ C C C ** DYE C - IF(ISDMPT.GE.1.AND.ISTRAN(3).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(3).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDDYE,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDDYE,POSITION='APPEND',FORM='UNFORMATTED') @@ -590,7 +591,7 @@ C C C ** TOTAL COHESIVE SEDIMENT WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSDW,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSDW,POSITION='APPEND',FORM='UNFORMATTED') @@ -619,7 +620,7 @@ C C C ** TOTAL NONCOHESIVE SEDIMENT IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSNW,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSNW,POSITION='APPEND',FORM='UNFORMATTED') @@ -648,7 +649,7 @@ C C C ** TOTAL TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTWT(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -680,7 +681,7 @@ C C C ** FREE DISSOLVED TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTWF(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -712,7 +713,7 @@ C C C ** COMPLEXED DISSOLVED TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTWC(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -744,7 +745,7 @@ C C C ** PARTICULATE TOXIC CONTAMINANT IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTWP(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -779,7 +780,7 @@ C C C ** TOTAL COHESIVE SEDIMENT IN BED C - IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSDB,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSDB,POSITION='APPEND',FORM='UNFORMATTED') @@ -804,7 +805,7 @@ C C C ** TOTAL NONCOHESIVE SEDIMENT IN BED C - IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDSNB,POSITION='APPEND') IF(ISDUMP.EQ.2) & OPEN(1,FILE=FNDSNB,POSITION='APPEND',FORM='UNFORMATTED') @@ -829,7 +830,7 @@ C C C ** THICKNESS OF SEDIMENT BED C - IF(ISDMPT.GE.1)THEN + IF(ISDMPT.GE.1.AND.MYRANK.EQ.0)THEN IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDBDH,POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -856,7 +857,7 @@ C C C ** TOTAL TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTBT(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -884,7 +885,7 @@ C C C ** FREE DISSOLVED TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTBF(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -912,7 +913,7 @@ C C C ** COMPLEXED DISSOLVED TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTBC(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -940,7 +941,7 @@ C C C ** PARTICULATE TOXIC CONTAMINANT IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.1) OPEN(1,FILE=FNDTBP(NT),POSITION='APPEND') IF(ISDUMP.EQ.2) @@ -977,7 +978,7 @@ C C C ** WATER SURFACE ELEVATION C - IF(ISDMPP.GE.1)THEN + IF(ISDMPP.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSEL,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSEL,POSITION='APPEND',FORM='UNFORMATTED') @@ -997,7 +998,7 @@ C C C ** U VELOCITY COMPONENT C - IF(ISDMPU.GE.1)THEN + IF(ISDMPU.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDUUU,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDUUU,POSITION='APPEND',FORM='UNFORMATTED') @@ -1027,7 +1028,7 @@ C C C ** V VELOCITY COMPONENT C - IF(ISDMPU.GE.1)THEN + IF(ISDMPU.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDVVV,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDVVV,POSITION='APPEND',FORM='UNFORMATTED') @@ -1057,7 +1058,7 @@ C C C ** W VELOCITY COMPONENT C - IF(ISDMPW.GE.1)THEN + IF(ISDMPW.GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDWWW,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDWWW,POSITION='APPEND',FORM='UNFORMATTED') @@ -1087,7 +1088,7 @@ C C C ** SALINITY C - IF(ISDMPT.GE.1.AND.ISTRAN(1).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(1).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSAL,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSAL,POSITION='APPEND',FORM='UNFORMATTED') @@ -1111,7 +1112,7 @@ C C C ** TEMPERATURE C - IF(ISDMPT.GE.1.AND.ISTRAN(2).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(2).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTEM,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDTEM,POSITION='APPEND',FORM='UNFORMATTED') @@ -1135,7 +1136,7 @@ C C C ** DYE C - IF(ISDMPT.GE.1.AND.ISTRAN(3).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(3).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDDYE,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDDYE,POSITION='APPEND',FORM='UNFORMATTED') @@ -1159,7 +1160,7 @@ C C C ** TOTAL COHESIVE SEDIMENT IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSDW,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSDW,POSITION='APPEND',FORM='UNFORMATTED') @@ -1183,7 +1184,7 @@ C C C ** TOTAL NONCOHESIVE SEDIMENT IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSNW,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSNW,POSITION='APPEND',FORM='UNFORMATTED') @@ -1207,7 +1208,7 @@ C C C ** TOTAL TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTWT(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1234,7 +1235,7 @@ C C C ** FREE DISSOLVED TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTWF(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1261,7 +1262,7 @@ C C C ** COMPLEXED DISSOLVED TOXIC CONTAMINANTS IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTWC(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1288,7 +1289,7 @@ C C C ** PARTICULATE TOXIC CONTAMINANT IN WATER COLUMN C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTWP(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1315,7 +1316,7 @@ C C C ** TOTAL COHESIVE SEDIMENT IN BED C - IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(6).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSDB,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSDB,POSITION='APPEND',FORM='UNFORMATTED') @@ -1337,7 +1338,7 @@ C C C ** TOTAL NONCOHESIVE SEDIMENT IN BED C - IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(7).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDSNB,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDSNB,POSITION='APPEND',FORM='UNFORMATTED') @@ -1360,7 +1361,7 @@ C C ** THICKNESS OF SEDIMENT BED C IF(ISDMPT.GE.1)THEN - IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1.AND.MYRANK.EQ.0)THEN IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDBDH,POSITION='APPEND') IF(ISDUMP.EQ.4) & OPEN(1,FILE=FNDBDH,POSITION='APPEND',FORM='UNFORMATTED') @@ -1383,7 +1384,7 @@ C C C ** TOTAL TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTBT(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1408,7 +1409,7 @@ C C C ** FREE DISSOLVED TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTBF(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1433,7 +1434,7 @@ C C C ** COMPLEXED DISSOLVED TOXIC CONTAMINANTS IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTBC(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) @@ -1458,7 +1459,7 @@ C C C ** PARTICULATE TOXIC CONTAMINANT IN SEDIMENT BED C - IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1)THEN + IF(ISDMPT.GE.1.AND.ISTRAN(5).GE.1.AND.MYRANK.EQ.0)THEN DO NT=1,NTOX IF(ISDUMP.EQ.3) OPEN(1,FILE=FNDTBP(NT),POSITION='APPEND') IF(ISDUMP.EQ.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/GATECTLREAD.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/GATECTLREAD.for index 6c5361a17..a7ccd6ae0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/GATECTLREAD.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/GATECTLREAD.for @@ -8,7 +8,7 @@ C ** READ FROM GATECTL.INP FILE C ** GATE INFORMATION AND CONTROL ENVIROMENT C USE GLOBAL - + USE MPI CHARACTER*3 NCARD ! { GEOSR ESTURAY DIKE : JGCHO 2010.11.16 REAL JULDAY,AJULDAY(NGTYPES),YEARTMP @@ -24,16 +24,16 @@ C GC1** NUMBER OF GATE TYPE NCARD='1' CALL SEEK('GC1') READ(1,*,ERR=1000) NGTYPES,GARTM,IWSYS - WRITE(7,1002)NCARD - WRITE(7,*) NGTYPES,GARTM,IWSYS + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) NGTYPES,GARTM,IWSYS C C GC2** READ GATE INFORMATION 1 NCARD='2' CALL SEEK('GC2') DO L=1,NQCTL READ(1,*,ERR=1000) NGATEM(L),NGATEC(L),NGTYP(L) - WRITE(7,1002)NCARD - WRITE(7,*) NGATEM(L),NGATEC(L),NGTYP(L) + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) NGATEM(L),NGATEC(L),NGTYP(L) !NGATE(L),NGATEC(L),NGTYP(L) ENDDO C C GC3** READ GATE INFORMATION 2 @@ -43,8 +43,8 @@ C GC3** READ GATE INFORMATION 2 READ(1,*,ERR=1000) SILL(L),SILLHH(L),GATEHI(L),GATEHO(L) & ,GATEWI(L),GATEWO(L),MAXQ(L) & ,GOTIME(L),GCTIME(L),IATS(L) - WRITE(7,1002)NCARD - WRITE(7,*) SILL(L),SILLHH(L),GATEHI(L),GATEHO(L) + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) SILL(L),SILLHH(L),GATEHI(L),GATEHO(L) & ,GATEWI(L),GATEWO(L),MAXQ(L),GOTIME(L),GCTIME(L) & ,IATS(L) ENDDO @@ -55,9 +55,9 @@ C GC4** READ FLOW CONSTANT DO L=1,NGTYPES READ(1,*,ERR=1000) CGH1(L),CGH2(L),CG1(L),CG2(L),CG3(L),CG4(L) !ung 20141108 & ,CG5(L),CG6(L),CG7(L),CG8(L),NCG3FOM(L) !ung 20141108 - WRITE(7,1002)NCARD - WRITE(7,*) CGH1(L),CGH2(L),CG1(L),CG2(L),CG3(L),CG4(L) !ung 20141108 - & ,CG5(L),CG6(L),CG7(L),CG8(L),NCG3FOM(L),L !ung 20141108 + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) CGH1(L),CGH2(L),CG1(L),CG2(L), !ung 20141108 + & CG5(L),CG6(L),CG7(L),CG8(L),NCG3FOM(L),L !ung 20141108 ENDDO C C GC5** READ GATE CONTROL @@ -66,8 +66,8 @@ C GC5** READ GATE CONTROL DO L=1,NGTYPES READ(1,*,ERR=1000) DELHINOUT(L),DELHSEL1(L) & ,DUM,DUM,TIDCHK(L) - WRITE(7,1002)NCARD - WRITE(7,*) DELHINOUT(L),DELHSEL1(L),DUM,DUM + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) DELHINOUT(L),DELHSEL1(L),DUM,DUM ! SEL1, 2(L) -> DUM & ,TIDCHK(L),L ENDDO C @@ -76,8 +76,8 @@ C GC6** NUMBER OF SURFACE LEVEL COMPARE CELL CALL SEEK('GC6') DO L=1,NGTYPES READ(1,*,ERR=1000) NICMP(L),NOCMP(L) - WRITE(7,1002)NCARD - WRITE(7,*) NICMP(L),NOCMP(L),L + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) NICMP(L),NOCMP(L),L ENDDO C C GC7** CELL INDEX OF UPSTREAM @@ -86,8 +86,8 @@ C GC7** CELL INDEX OF UPSTREAM DO L=1,NGTYPES DO LL=1,NICMP(L) READ(1,*,ERR=1000) ICMPI(LL,L),JCMPI(LL,L) - WRITE(7,1002)NCARD - WRITE(7,*) ICMPI(LL,L),JCMPI(LL,L),L + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) ICMPI(LL,L),JCMPI(LL,L),L ENDDO ENDDO C @@ -97,8 +97,8 @@ C GC8** CELL INDEX OF DOWNSTREAM DO L=1,NGTYPES DO LL=1,NOCMP(L) READ(1,*,ERR=1000) ICMPO(LL,L),JCMPO(LL,L) - WRITE(7,1002)NCARD - WRITE(7,*) ICMPO(LL,L),JCMPO(LL,L),L + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) ICMPO(LL,L),JCMPO(LL,L),L ENDDO ENDDO ! { GEOSR ESTURAY DIKE : JGCHO 2010.11.15 @@ -108,8 +108,8 @@ C GC9** CONSIDER ESTUARY DIKE OUTER TIDE START TIME CALL SEEK('GC9') DO L=1,NGTYPES READ(1,*,ERR=1000) IGYY(L),IGMM(L),IGDD(L),CLOC(L) - WRITE(7,1002)NCARD - WRITE(7,*) IGYY(L),IGMM(L),IGDD(L),CLOC(L),L + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) IGYY(L),IGMM(L),IGDD(L),CLOC(L),L ENDDO ! } GEOSR ESTURAY DIKE : JGCHO 2010.11.15 C @@ -117,8 +117,8 @@ C GC10** GATE FLUX MONITORING NCARD='10' CALL SEEK('GC10') READ(1,*,ERR=1000) ISINK,DTSNK - WRITE(7,1002)NCARD - WRITE(7,*) ISINK,DTSNK + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,*) ISINK,DTSNK C CLOSE(1) C @@ -156,9 +156,11 @@ C ELSE YEARTMP=NINT(YEARTMP)*10. ENDIF + IF(MYRANK.EQ.0) THEN WRITE(FNTIDE,'(A,I4.4,A)') TRIM(CLOC(L)),INT(YEARTMP),'.INP' WRITE(*,*) 'READING PREDICTION TIDE DATA : ', TRIM(FNTIDE) WRITE(7,*) 'READING PREDICTION TIDE DATA : ', TRIM(FNTIDE) + ENDIF NTIDE=0 OPEN(1,FILE=TRIM(FNTIDE)) @@ -174,7 +176,8 @@ C ENDIF ! } GEOSR ESTURAY DIKE, READ DATE : JGCHO 2010.11.26 ESTIDE(L,NTIDE)=TIDETMP - WRITE(7,*) ESTIME(L,NTIDE),ESTIDE(L,NTIDE),IY,ID,HH + IF(MYRANK.EQ.0) WRITE(7,*) ESTIME(L,NTIDE), + & ESTIDE(L,NTIDE),IY,ID,HH IF (NTIDE .EQ. (NTC+1)*24+1) THEN CLOSE(1) GOTO 7003 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index e509355e2..72055d259 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -25,6 +25,7 @@ C USE GLOBAL USE DRIFTER USE WINDWAVE ,ONLY:WINDWAVEINIT,WINDWAVETUR + USE MPI INTRINSIC ISNAN LOGICAL ISNAN @@ -87,6 +88,8 @@ C FOURDPI=4./PI ISTL=2 IS2TL=1 + MPI_WTIMES=0 + CALL MPI_INITIALIZE C C**********************************************************************C C @@ -322,7 +325,7 @@ C----------------------------------------------------------------------c C IF(ISCORTBC.GE.1) THEN C - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN IF(ISCORTBCD.GE.1)THEN OPEN(1,FILE='ADJSTRESSE.OUT') CLOSE(1,STATUS='DELETE') @@ -496,6 +499,9 @@ C 1001 CONTINUE IF(N.GE.NTS)GO TO 1000 C +C ITERATION START + TTIME=MPI_TIC() + STIME=MPI_TIC() IF(ISDYNSTP.EQ.0)THEN N=N+1 ETIMESEC=DT*FLOAT(N) @@ -524,10 +530,9 @@ C TIMESEC=(DT*FLOAT(N)+TCON*TBEGIN) TIMEDAY=(DT*FLOAT(N)+TCON*TBEGIN)/86400. ENDIF - PRINT*, "TIME: ", TIMEDAY C C PMC IF(ILOGC.EQ.NTSMMT)THEN - IF(ILOGC.EQ.NTSPTC)THEN + IF(ILOGC.EQ.NTSPTC.AND.MYRANK.EQ.0)THEN CLOSE(8,STATUS='DELETE') OPEN(8,FILE='EFDCLOG.OUT',STATUS='UNKNOWN') IF(DEBUG)THEN @@ -590,6 +595,9 @@ C GP=GPO ENDIF C + MPI_WTIMES(2)=MPI_WTIMES(2)+MPI_TOC(STIME) + STIME=MPI_TIC() +C C----------------------------------------------------------------------C C C ** INITIALIZE TWO-TIME LEVEL BALANCES @@ -600,6 +608,8 @@ C ENDIF ENDIF C + MPI_WTIMES(3)=MPI_WTIMES(3)+MPI_TOC(STIME) +C C----------------------------------------------------------------------C C C ** REENTER HERE FOR TWO TIME LEVEL LOOP @@ -610,7 +620,8 @@ C**********************************************************************C C C ** CALCULATE VERTICAL VISCOSITY AND DIFFUSIVITY AT TIME LEVEL (N) C - CALL CPU_TIME(T1TMP) + STIME=MPI_TIC() !!### WT_CALAVB +C CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALAVBOLD (ISTL) @@ -618,17 +629,18 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALAVB2 (ISTL) ENDIF - CALL CPU_TIME(T2TMP) - TAVB=TAVB+T2TMP-T1TMP +C TAVB=TAVB+T1TMP-SECOND() + MPI_WTIMES(4)=MPI_WTIMES(4)+MPI_TOC(STIME) C C**********************************************************************C C C ** CALCULATE WAVE BOUNDARY LAYER AND WAVE REYNOLDS STRESS FORCINGS C + STIME=MPI_TIC() IF(ISWAVE.EQ.1) CALL WAVEBL IF(ISWAVE.EQ.2) CALL WAVESXY IF(ISWAVE.EQ.3.AND.NWSER > 0) CALL WINDWAVETUR !DHC NEXT CALL - + MPI_WTIMES(5)=MPI_WTIMES(5)+MPI_TOC(STIME) C C**********************************************************************C C @@ -637,40 +649,46 @@ C ** STRESSES *** DSLLC MOVED C C----------------------------------------------------------------------C C + STIME=MPI_TIC() !!### WT_CALTSXY CALL CALTSXY + MPI_WTIMES(6)=MPI_WTIMES(6)+MPI_TOC(STIME) C C**********************************************************************C C C ** CALCULATE EXPLICIT MOMENTUM EQUATION TERMS C - T1TMP=SECNDS(0.0) -c IF(IS2TIM.EQ.1) CALL CALEXP2T + STIME=MPI_TIC() !!### WT_CALEXP2T +C CALL CPU_TIME(T1TMP) IF(IS2TIM.EQ.1.AND.N.EQ.1) PRINT*, 'RUN CALEXP2T' IF(IS2TIM.EQ.2.AND.N.EQ.1) PRINT*, 'RUN CALIMP2T' IF(IS2TIM.EQ.1) CALL CALEXP2T IF(IS2TIM.EQ.2) CALL CALIMP2T - TCEXP=TCEXP+T1TMP-SECOND() +C TCEXP=TCEXP+T1TMP-SECOND() + MPI_WTIMES(7)=MPI_WTIMES(7)+MPI_TOC(STIME) C C**********************************************************************C C C ** UPDATE TIME VARIABLE VOLUME SOURCES AND SINKS, CONCENTRATIONS, C ** VEGETATION CHARACTERISTICS AND SURFACE ELEVATIONS C + STIME=MPI_TIC() !!### WT_CALCSER CALL CALCSER (ISTL) CALL CALVEGSER (ISTL) CALL CALQVS (ISTL) PSERT(0)=0. IF(NPSER.GE.1) CALL CALPSER (ISTL) + MPI_WTIMES(8)=MPI_WTIMES(8)+MPI_TOC(STIME) C C**********************************************************************C C C ** SOLVE EXTERNAL MODE EQUATIONS FOR P, UHDYE, AND VHDXE C - CALL CPU_TIME(T1TMP) + STIME=MPI_TIC() !!### WT_CALPUV2C +C CALL CPU_TIME(T1TMP) IF(ISCHAN.EQ.0.AND.ISDRY.EQ.0) CALL CALPUV2T IF(ISCHAN.GE.1.OR.ISDRY.GE.1) CALL CALPUV2C - CALL CPU_TIME(T2TMP) - TPUV=TPUV+T2TMP-T1TMP +C TPUV=TPUV+T1TMP-SECOND() + MPI_WTIMES(9)=MPI_WTIMES(9)+MPI_TOC(STIME) C C**********************************************************************C C @@ -699,6 +717,7 @@ C ** ADVANCE INTERNAL VARIABLES C C----------------------------------------------------------------------C C + STIME=MPI_TIC() !!### WT_ADVANCE DO K=1,KC DO L=2,LA UHDY2(L,K)=UHDY1(L,K) @@ -713,6 +732,7 @@ C W1(L,K)=W(L,K) ENDDO ENDDO + MPI_WTIMES(10)=MPI_WTIMES(10)+MPI_TOC(STIME) C C**********************************************************************C C @@ -720,7 +740,8 @@ C ** SOLVE INTERNAL SHEAR MODE EQUATIONS FOR U, UHDY, V, VHDX, AND W C C----------------------------------------------------------------------C C - CALL CPU_TIME(T1TMP) + STIME=MPI_TIC() !!### WT_CALUVW +C CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN CALL CALUVW (ISTL,IS2TL) ELSE @@ -733,8 +754,8 @@ C ENDDO CALL CALUVW (ISTL,IS2TL) ENDIF - CALL CPU_TIME(T2TMP) - TUVW=TUVW+T2TMP-T1TMP +C TUVW=TUVW+T1TMP-SECOND() + MPI_WTIMES(11)=MPI_WTIMES(11)+MPI_TOC(STIME) C C**********************************************************************C C @@ -743,9 +764,13 @@ C ** AT TIME LEVEL (N+1) C C----------------------------------------------------------------------C C + STIME=MPI_TIC() !!### WT_CALCONC CALL CALCONC (ISTL,IS2TL) + MPI_WTIMES(12)=MPI_WTIMES(12)+MPI_TOC(STIME) C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() !!### WT_PMC C ! *** PMC BYPASS IF NOT SIMULATING SEDIMENTS IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN @@ -796,9 +821,12 @@ C ENDDO ENDIF C + MPI_WTIMES(13)=MPI_WTIMES(13)+MPI_TOC(STIME) C----------------------------------------------------------------------C C C ** CHECK RANGE OF SALINITY AND DYE CONCENTRATION +C + STIME=MPI_TIC() C IF(ISMMC.EQ.1)THEN C @@ -902,6 +930,8 @@ C C ENDIF C + MPI_WTIMES(14)=MPI_WTIMES(14)+MPI_TOC(STIME) +C 6001 FORMAT(' N=',I10) 6002 FORMAT(' SALMAX=',F14.4,5X,'I,J,K=',(3I10)) 6003 FORMAT(' SALMIN=',F14.4,5X,'I,J,K=',(3I10)) @@ -912,8 +942,10 @@ C 6008 FORMAT(' TEMMAX=',F14.4,5X,'I,J,K=',(3I10)) 6009 FORMAT(' TEMMIN=',F14.4,5X,'I,J,K=',(3I10)) + STIME=MPI_TIC() !!### MPI_WRITE +C ! *** DSLLC - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN BTEST=.FALSE. LTEST=.FALSE. DO L=2,LA @@ -1103,6 +1135,8 @@ C 918 FORMAT('ERROR: TIME, L, I, J, K, NW, WQV = ',F10.5,5I6,2F10.4) ENDIF C + MPI_WTIMES(15)=MPI_WTIMES(15)+MPI_TOC(STIME) +C C**********************************************************************C C C ** CALCULATE SHELL FISH LARVAE AND/OR WATER QUALITY CONSTITUENT @@ -1110,6 +1144,8 @@ C ** CONCENTRATIONS AT TIME LEVEL (N+1) AFTER SETTING DOUBLE TIME C ** STEP TRANSPORT FIELD C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() !!### WT_WQ3D C ITMP=0 IF(ISTRAN(4).GE.1) ITMP=1 @@ -1167,6 +1203,8 @@ C C C END ADD CHANNEL INTERACTIONS C + IF(ISTRAN(8).GE.1.AND.N.EQ.1) PRINT*,'RUN WQ3D',ISTL,IS2TL + IF(ISTRAN(4).GE.1.AND.N.EQ.1) PRINT*,'RUN CALSFT',ISTL,IS2TL IF(ISTRAN(8).GE.1) CALL WQ3D(ISTL,IS2TL) IF(ISTRAN(4).GE.1) CALL CALSFT(ISTL,IS2TL) C @@ -1176,10 +1214,14 @@ C C ENDIF C + MPI_WTIMES(16)=MPI_WTIMES(16)+MPI_TOC(STIME) +C C**********************************************************************C C C ** UPDATE BUOYANCY AND CALCULATE NEW BUOYANCY USING C ** AN EQUATION OF STATE +C + STIME=MPI_TIC() !!### WT_CALBUOY C DO K=1,KC DO L=2,LA @@ -1197,12 +1239,17 @@ C ENDDO ENDIF C + MPI_WTIMES(17)=MPI_WTIMES(17)+MPI_TOC(STIME) C ** CALL TWO-TIME LEVEL BALANCES +C + STIME=MPI_TIC() C IF(ISBAL.GE.1)THEN CALL BAL2T4 ENDIF C + MPI_WTIMES(18)=MPI_WTIMES(18)+MPI_TOC(STIME) +C C**********************************************************************C C C ** CALCULATE U AT V AND V AT U AT TIME LEVEL (N+1) @@ -1225,18 +1272,25 @@ C & +HP(L)*(V(LN,1)+V(L,1)))*HUI(L) ENDDO C + MPI_WTIMES(19)=MPI_WTIMES(19)+MPI_TOC(STIME) +C C**********************************************************************C C C ** CALCULATE HORIZONTAL VISCOSITY AND MOMENTUM DIFFUSION FLUXES C ** AT TIME LEVEL (N) +C + STIME=MPI_TIC() !!### WT_CALHDMF C IF(ISHDMF.GE.1) CALL CALHDMF C + MPI_WTIMES(20)=MPI_WTIMES(20)+MPI_TOC(STIME) +C C**********************************************************************C C C ** CALCULATE BOTTOM STRESS AT LEVEL (N+1) C - CALL CPU_TIME(T1TMP) +C CALL CPU_TIME(T1TMP) + STIME=MPI_TIC() !!### WT_CALTBXY C CALL CALTBXY(ISTL,IS2TL) C @@ -1247,9 +1301,13 @@ C & +V(L,1)*V(L,1)))*V(L,1) ENDDO C + MPI_WTIMES(21)=MPI_WTIMES(21)+MPI_TOC(STIME) +C C**********************************************************************C C C ** SET DEPTH DEVIATION FROM UNIFORM FLOW ON FLOW FACES +C + STIME=MPI_TIC() C IF(ISBSDFUF.GE.1)THEN HDFUFM=1.E-12 @@ -1277,6 +1335,8 @@ C C ENDIF C + MPI_WTIMES(22)=MPI_WTIMES(22)+MPI_TOC(STIME) +C C**********************************************************************C C C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED AT (N+1) @@ -1284,7 +1344,9 @@ C C----------------------------------------------------------------------C C C - IF(ISWAVE.EQ.0)THEN + IF(ISWAVE.EQ.0)THEN !!### WT_QQSQR +C + STIME=MPI_TIC() C C----------------------------------------------------------------------c C @@ -1321,7 +1383,11 @@ C C ENDIF C + MPI_WTIMES(23)=MPI_WTIMES(23)+MPI_TOC(STIME) +C C----------------------------------------------------------------------c +C + STIME=MPI_TIC() C IF(ISCORTBC.GE.1) THEN C @@ -1448,6 +1514,8 @@ C C C----------------------------------------------------------------------c C + MPI_WTIMES(25)=MPI_WTIMES(25)+MPI_TOC(STIME) +C ENDIF C 3678 FORMAT(2I6,4F13.3) @@ -1465,6 +1533,8 @@ C C ** SET BOTTOM AND SURFACE TURBULENT INTENSITY SQUARED AT (N+1) C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() C IF(ISWAVE.GE.1)THEN C @@ -1503,13 +1573,17 @@ C C ENDIF C - TTBXY=TTBXY+SECNDS(T1TMP) + MPI_WTIMES(26)=MPI_WTIMES(26)+MPI_TOC(STIME) +C +C TTBXY=TTBXY+T1TMP-SECOND() C C**********************************************************************C C C ** CALCULATE TURBULENT INTENSITY SQUARED C - CALL CPU_TIME(T1TMP) + STIME=MPI_TIC() !!### WT_CALQQ2T +C +C CALL CPU_TIME(T1TMP) IF(KC.GT.1)THEN IF(ISQQ.EQ.1)THEN IF(ISTOPT(0).EQ.0)CALL CALQQ2TOLD (ISTL) @@ -1517,11 +1591,15 @@ C ENDIF IF(ISQQ.EQ.2) CALL CALQQ2 (ISTL) ENDIF - TQQQ=TQQQ+SECNDS(T1TMP) +C TQQQ=TQQQ+T1TMP-SECOND() +C + MPI_WTIMES(27)=MPI_WTIMES(27)+MPI_TOC(STIME) C C**********************************************************************C C C ** CALCULATE MEAN MASS TRANSPORT FIELD +C + STIME=MPI_TIC() C IF(ISSSMMT.NE.2)THEN IF(ISICM.GE.1)THEN @@ -1532,6 +1610,8 @@ C C C IF(ISSSMMT.NE.2) CALL CALMMT C + MPI_WTIMES(28)=MPI_WTIMES(28)+MPI_TOC(STIME) +C C**********************************************************************C C C ** HYDRODYNAMIC CALCULATIONS FOR THIS TIME STEP ARE COMPLETED @@ -1539,6 +1619,8 @@ C C**********************************************************************C C C ** WRITE TO TIME SERIES FILES +C + STIME=MPI_TIC() C IF(ISDYNSTP.EQ.0)THEN CTIM=DT*FLOAT(N)+TCON*TBEGIN @@ -1600,7 +1682,7 @@ C C----------------------------------------------------------------------C C IF(ISDRY.GE.1.AND.ISDRY.LT.98)THEN - IF(ICALLTP.EQ.1.AND.DEBUG)THEN + IF(ICALLTP.EQ.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='ZVOLBAL.OUT',POSITION='APPEND',STATUS='UNKNOWN') DO LS=1,LORMAX IF(VOLZERD.GE.VOLSEL(LS).AND.VOLZERD.LT.VOLSEL(LS+1))THEN @@ -1637,9 +1719,13 @@ C ENDIF ENDIF C + MPI_WTIMES(29)=MPI_WTIMES(29)+MPI_TOC(STIME) +C C**********************************************************************C C C ** CALCULATE MEAN MASS TRANSPORT FIELD +C + STIME=MPI_TIC() C IF(ISSSMMT.NE.2)THEN IF(ISICM.EQ.0) CALL CALMMT @@ -1647,13 +1733,17 @@ C C C IF(ISSSMMT.NE.2) CALL CALMMT C + MPI_WTIMES(30)=MPI_WTIMES(30)+MPI_TOC(STIME) +C C**********************************************************************C C C ** ADVANCE NEUTRALLY BUOYANT PARTICLE DRIFTER TRAJECTORIES C !IF(ISPD.EQ.1)THEN ! IF(N.GE.NPDRT) CALL DRIFTER - +C + STIME=MPI_TIC() +C !{GEOSR, OIL, CWCHO, 101122 IF(ISPD.GE.2.AND.IDTOX.LT.4440) THEN !DHC IF (TIMEDAY.GE.LA_BEGTI.AND.TIMEDAY.LE.LA_ENDTI) THEN @@ -1672,7 +1762,9 @@ C ENDIF ENDIF !GEOSR} - +C + MPI_WTIMES(31)=MPI_WTIMES(31)+MPI_TOC(STIME) +C ! IF(ISLRPD.GE.1)THEN ! CALL CPU_TIME(T1TMP) !DHC:13-04-09 ! IF(ISLRPD.LE.2)THEN @@ -1711,41 +1803,59 @@ C CALL BUDGOD5 C ENDIF C C ** CALL TWO-TIME LEVEL BALANCES +C + STIME=MPI_TIC() C IF(ISBAL.GE.1)THEN CALL BAL2T5 ENDIF +C + MPI_WTIMES(32)=MPI_WTIMES(32)+MPI_TOC(STIME) C C**********************************************************************C C C ** PERFORM AN M2 TIDE HARMONIC ANALYSIS EVERY 2 M2 PERIODS +C + STIME=MPI_TIC() C IF(ISHTA.EQ.1) CALL CALHTA +C + MPI_WTIMES(33)=MPI_WTIMES(33)+MPI_TOC(STIME) C C**********************************************************************C C C ** CALCULATE DISPERSION COEFFICIENTS C C IF(N.GE.NDISP)THEN + STIME=MPI_TIC() +C IF(N.GE.NDISP.AND.NCTBC.EQ.1)THEN IF(ISDISP.EQ.2) CALL CALDISP2 IF(ISDISP.EQ.3) CALL CALDISP3 ENDIF +C + MPI_WTIMES(34)=MPI_WTIMES(34)+MPI_TOC(STIME) C C**********************************************************************C C C ** PERFORM LEAST SQUARES HARMONIC ANALYSIS AT SELECTED LOCATIONS +C + STIME=MPI_TIC() C IF(ISLSHA.EQ.1.AND.N.EQ.NCLSHA)THEN CALL LSQHARM NCLSHA=NCLSHA+(NTSPTC/24) ENDIF +C + MPI_WTIMES(35)=MPI_WTIMES(35)+MPI_TOC(STIME) C C**********************************************************************C C C ** PRINT INTERMEDIATE RESULTS C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() C IF(NPRINT .EQ. NTSPP)THEN NPRINT=1 @@ -1753,6 +1863,8 @@ C ELSE NPRINT=NPRINT+1 ENDIF +C + MPI_WTIMES(36)=MPI_WTIMES(36)+MPI_TOC(STIME) C C**********************************************************************C C @@ -1762,14 +1874,21 @@ C----------------------------------------------------------------------C C CDYN IF(N.EQ.NCPPH.AND.ISPPH.EQ.1)THEN Cpmc IF(N.GE.NCPPH.AND.ISPPH.GE.1)THEN +C + STIME=MPI_TIC() +C IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN CALL SURFPLT ENDIF +C + MPI_WTIMES(37)=MPI_WTIMES(37)+MPI_TOC(STIME) C C C----------------------------------------------------------------------C C CDYN IF(N.EQ.NCBPH.AND.ISBPH.EQ.1)THEN +C + STIME=MPI_TIC() C IF(N.GE.NCBPH.AND.ISBPH.GE.1)THEN IF(ISBEXP.EQ.0)THEN @@ -1777,27 +1896,39 @@ C NCBPH=NCBPH+(NTSPTC/NPBPH) ENDIF ENDIF +C + MPI_WTIMES(38)=MPI_WTIMES(38)+MPI_TOC(STIME) C C----------------------------------------------------------------------C C CDYN IF(N.EQ.NCVPH.AND.ISVPH.GE.1)THEN +C + STIME=MPI_TIC() !!### WT_VELPLTH C IPLTTMP=0 IF(ISVPH.EQ.1.OR.ISVPH.EQ.2)IPLTTMP=1 IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS).AND.IPLTTMP.EQ.1)THEN CALL VELPLTH ENDIF +C + MPI_WTIMES(39)=MPI_WTIMES(39)+MPI_TOC(STIME) C C----------------------------------------------------------------------C C CDYN IF(N.EQ.NCVPV.AND.ISVPV.GE.1)THEN +C + STIME=MPI_TIC() C IF(N.GE.NCVPV.AND.ISVPV.GE.1)THEN CALL VELPLTV NCVPV=NCVPV+(NTSPTC/NPVPV) ENDIF +C + MPI_WTIMES(40)=MPI_WTIMES(40)+MPI_TOC(STIME) C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() !!### WT_SALPLTH C DO K=1,KC DO L=1,LC @@ -1853,8 +1984,12 @@ C IF(ISTRAN(7).GE.1) CALL SALPLTH (7,SNDT) NCSPH(7)=NCSPH(7)+(NTSPTC/NPSPH(7)) ENDIF +C + MPI_WTIMES(41)=MPI_WTIMES(41)+MPI_TOC(STIME) C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() C DO ITMP=1,7 IF(N.GE.NCSPV(ITMP).AND.ISSPV(ITMP).GE.1)THEN @@ -1862,10 +1997,14 @@ C NCSPV(ITMP)=NCSPV(ITMP)+(NTSPTC/NPSPV(ITMP)) ENDIF ENDDO +C + MPI_WTIMES(42)=MPI_WTIMES(42)+MPI_TOC(STIME) C C----------------------------------------------------------------------C C C ** WRITE EFDC EXPLORER FORMAT OUTPUT +C + STIME=MPI_TIC() !!### WT_EEXPOUT C IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1)THEN IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN @@ -1875,21 +2014,29 @@ C IF(TIMEDAY.GE.SNAPSHOTS(NSNAPSHOTS))THEN NSNAPSHOTS=NSNAPSHOTS+1 ENDIF +C + MPI_WTIMES(43)=MPI_WTIMES(43)+MPI_TOC(STIME) C C**********************************************************************C C C ** WRITE TO TIME VARYING 3D HDF GRAPHICS FILES C C----------------------------------------------------------------------C +C + STIME=MPI_TIC() C IF(N.EQ.NC3DO.AND.IS3DO.EQ.1)THEN CALL OUT3D NC3DO=NC3DO+(NTSPTC/NP3DO) ENDIF +C + MPI_WTIMES(44)=MPI_WTIMES(44)+MPI_TOC(STIME) C C**********************************************************************C C C ** WRITE RESTART FILE EVERY ISRESTO M2 TIDAL CYCLES +C + STIME=MPI_TIC() C IF(ISRESTO.GE.1)THEN IF((N-ISSREST).GT.NRESTO)THEN @@ -1923,12 +2070,14 @@ C ENDIF IF(TIMEDAY.GE.SNAPSHOTHYD) THEN ! WRITE(*,*)'WRITE================',N,TIMEDAY,TIMEDAY*1440. - CALL RESTOUT(-21) +! CALL RESTOUT(-21) IHYDCNT=IHYDCNT+1 SNAPSHOTHYD=FLOAT(ISHYD*IHYDCNT)*60./86400.+TBEGIN ENDIF ENDIF ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 +C + MPI_WTIMES(45)=MPI_WTIMES(45)+MPI_TOC(STIME) C C**********************************************************************C C @@ -1954,6 +2103,16 @@ C**********************************************************************C C C *** DJB ![ykchoi 10.04.26 for linux version + MPI_WTIMES(1)=MPI_WTIMES(1)+MPI_TOC(TTIME) + IF(N.GE.NTSPTC/200)THEN + DO II=1,45 + IF(NINT(200*REAL(MPI_WTIMES(II))).GE.1) + & WRITE(*,'(I5,F10.3)') II, (10*REAL(MPI_WTIMES(II))) + + ENDDO + STOP 'LOOP MPI' + ENDIF + GOTO 1001 ! IF(.NOT.KBHIT())GOTO 1001 ! I1=GETCH() @@ -2025,7 +2184,7 @@ C C ** OUTPUT COURANT NUMBER DIAGNOSTICS C C *** DSLLC BEGIN BLOCK - IF(ISINWV.GT.0.AND.DEBUG)THEN + IF(ISINWV.GT.0.AND.DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='CFLMAX.OUT') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='CFLMAX.OUT') @@ -2049,7 +2208,7 @@ C**********************************************************************C C C ** OUTPUT COSMETIC VOLUME LOSSES FORM DRY CELLS C - IF(NDRYSTP.LT.0.AND.DEBUG) THEN + IF(NDRYSTP.LT.0.AND.DEBUG.AND.MYRANK.EQ.0) THEN C OPEN(1,FILE='DRYLOSS.OUT') CLOSE(1,STATUS='DELETE') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INITBIN3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INITBIN3.for index 76792632a..22fbb6510 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INITBIN3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INITBIN3.for @@ -7,6 +7,7 @@ C PARAMETERS FOR POST-PROCESSOR IN HEADER SECTION OF BINARY C FILE WQDOCOMP.BIN FOR D.O. COMPONENT ANALYSIS. C USE GLOBAL + USE MPI REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XLON REAL,SAVE,ALLOCATABLE,DIMENSION(:)::YLAT LOGICAL FEXIST,IS1OPEN,IS2OPEN @@ -162,7 +163,7 @@ C C C IF WQDOCOMP.BIN ALREADY EXISTS, OPEN FOR APPENDING HERE. C - IF(ISCOMP .EQ. 2)THEN + IF(ISCOMP .EQ. 2.AND.MYRANK.EQ.0)THEN IO = 1 5 IO = IO+1 IF(IO .GT. 99)THEN @@ -187,7 +188,7 @@ C C C IF WQDOCOMP.BIN ALREADY EXISTS, DELETE IT HERE. C - IF(ISCOMP .EQ. 1)THEN + IF(ISCOMP .EQ. 1.AND.MYRANK.EQ.0)THEN TBEGAN = TBEGIN IO = 1 10 IO = IO+1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for index 0633f08ce..6b0eff187 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/INPUT.for @@ -24,6 +24,7 @@ C ADDED SED-TOX DEBUG FLAG ISDTXBUG C USE GLOBAL USE DRIFTER,ONLY:DRIFTERINP, AREA_CENTRD + USE MPI REAL*4 SEEPRATE(1000) CHARACTER*80 TEXT,TITLE @@ -47,31 +48,34 @@ C C C ** READ MAIN INPUT FILE EFDC.INP C - PRINT *,'READING THE MAIN EFDC CONTROL FILE: EFDC.INP' + IF(MYRANK.EQ.0) + & PRINT *,'READING THE MAIN EFDC CONTROL FILE: EFDC.INP' OPEN(1,FILE='EFDC.INP',STATUS='UNKNOWN') C C1** READ TITLE CARD NCARD='1' CALL SEEK('C1') READ(1,2) TITLE - WRITE(7,1002)NCARD - WRITE(7,2) TITLE + IF(MYRANK.EQ.0) WRITE(7,1002)NCARD + IF(MYRANK.EQ.0) WRITE(7,2) TITLE C C2** READ RESTART AND DIAGNOSTIC SWITCHES NCARD='2' CALL SEEK('C2') READ(1,*,IOSTAT=ISO) ISRESTI,ISRESTO,ISRESTR,ISPAR,ISLOG,ISDIVEX, & ISNEGH,ISMMC,ISBAL,IS2TIM,ISHOW,ITIMING,IBIN_TYPE + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISRESTI,ISRESTO,ISRESTR,ISPAR,ISLOG,ISDIVEX, & ISNEGH,ISMMC,ISBAL,IS2TIM,ISHOW,ITIMING,IBIN_TYPE + ENDIF IF(ISMMC.LT.0)THEN DEBUG=.TRUE. ISMMC=0 - PRINT *,'DEBUG ON' + IF(MYRANK.EQ.0) PRINT *,'DEBUG ON' ELSE DEBUG=.FALSE. - PRINT *,'DEBUG OFF' + IF(MYRANK.EQ.0) PRINT *,'DEBUG OFF' ENDIF IF(ISO.GT.0) GOTO 100 C @@ -81,9 +85,11 @@ C3** READ RELAXATION PARAMETERS READ(1,*,IOSTAT=ISO) RP,RSQM,ITERM,IRVEC,RPADJ, & RSQMADJ,ITRMADJ,ITERHPM,IDRYCK,ISDSOLV,FILT3TL IF(ITRMADJ.LT.1)ITRMADJ=1 + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) RP,RSQM,ITERM,IRVEC,RPADJ, & RSQMADJ,ITRMADJ,ITERHPM,IDRYCK,ISDSOLV,FILT3TL + ENDIF IF(ISO.GT.0) GOTO 100 IF(IRVEC.NE. 0.AND.IRVEC.NE. 9.AND. & IRVEC.NE.99.AND.IRVEC.NE.9999)STOP 'INVALID IRVEC' @@ -93,9 +99,11 @@ C4** READ LONGTERM MASS TRANSPORT INTEGRATION ONLY SWITCHES CALL SEEK('C4') READ(1,*,IOSTAT=ISO) ISLTMT,ISSSMMT,ISLTMTS,ISIA,RPIA,RSQMIA, & ITRMIA,ISAVEC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISLTMT,ISSSMMT,ISLTMTS,ISIA,RPIA,RSQMIA, & ITRMIA,ISAVEC + ENDIF IF(ISO.GT.0) GOTO 100 C C5** READ MOMENTUM ADVECTION AND DIFFUSION SWITCHES AND MISC @@ -103,9 +111,11 @@ C5** READ MOMENTUM ADVECTION AND DIFFUSION SWITCHES AND MISC CALL SEEK('C5') READ(1,*,IOSTAT=ISO) ISCDMA,ISHDMF,ISDISP,ISWASP,ISDRY, & ISQQ,ISRLID,ISVEG,ISVEGL,ISITB,ISEVER,IINTPG + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISCDMA,ISHDMF,ISDISP,ISWASP,ISDRY, & ISQQ,ISRLID,ISVEG,ISVEGL,ISITB,ISEVER,IINTPG + ENDIF IF(ISO.GT.0) GOTO 100 IDRYTBP=0 IF(ISDRY.LT.0)THEN @@ -126,9 +136,11 @@ C READ(1,*,IOSTAT=ISO) ISTRAN(N),ISTOPT(N),ISCDCA(N),ISADAC(N), & ISFCT(N),ISPLIT(N),ISADAH(N),ISADAV(N),ISCI(N),ISCO(N) IF(ISCDCA(N).GE.4) ISCOSMIC=1 + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISTRAN(N),ISTOPT(N),ISCDCA(N),ISADAC(N), & ISFCT(N),ISPLIT(N),ISADAH(N),ISADAV(N),ISCI(N),ISCO(N) + ENDIF !{GeoSR, YSSONG, TOXIC, 101031, 101125 IF(IDTOX.GT.0.AND.IDTOX.LT.4440) ISTRAN(5)=1 ! TOXIC MODULE ON @@ -144,9 +156,11 @@ C7** READ TIME-RELATED INTEGER PARAMETERS & NTCVB,NTSMMT,NFLTMT,NDRYSTP ! READ(1,*,IOSTAT=ISO) NTC,NTSPTC,NLTC,NTTC,NTCPP,NTSTBC, ! & KSW,NTCVB,NTSMMT,NFLTMT,NDRYSTP + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) NTC,NTSPTC,NLTC,NTTC,NTCPP,NTSTBC,NTCNB, & NTCVB,NTSMMT,NFLTMT,NDRYSTP + ENDIF IF(ISO.GT.0) GOTO 100 C C8** READ TIME-RELATED REAL PARAMETERS @@ -164,9 +178,11 @@ C8** READ TIME-RELATED REAL PARAMETERS ENDIF !} + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) TCON,TBEGIN,TIDALP,CF,ISCORV,ISDCCA, & ISCFL,ISCFLM,DTSSFAC + ENDIF IF(ISO.GT.0) GOTO 100 IF(DTSSFAC.GT.0.0)THEN ISDYNSTP=1 @@ -180,9 +196,11 @@ C9** READ SPACE RELATED AND SMOOTHING PARAMETERS CALL SEEK('C9') READ(1,*,IOSTAT=ISO) KC,IC,JC,LC,LVC,ISCLO,NDM,LDM,ISMASK, & ISPGNS,NSHMAX,NSBMAX,WSMH,WSMB + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) KC,IC,JC,LC,LVC,ISCLO,NDM,LDM,ISMASK, & ISPGNS,NSHMAX,NSBMAX,WSMH,WSMB + ENDIF IF(ISO.GT.0) GOTO 100 IS2LMC=0 IF(KC.LT.0) THEN @@ -208,8 +226,10 @@ C10* READ LAYER THICKNESS IN VERTICAL CALL SEEK('C10') DO K=1,KC READ(1,*,IOSTAT=ISO)KDUM,DZC(K) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)KDUM,DZC(K) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -218,9 +238,11 @@ C11* READ GRID, ROUGHNESS, MASKING AND DEPTH PARAMETERS CALL SEEK('C11') READ(1,*,IOSTAT=ISO) DX,DY,DXYCVT,IMDXDY,ZBRADJ,ZBRCVRT,HMIN, & HADADJ,HCVRT,HDRY,HWET,BELADJ,BELCVRT + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) DX,DY,DXYCVT,IMDXDY,ZBRADJ,ZBRCVRT,HMIN, & HADADJ,HCVRT,HDRY,HWET,BELADJ,BELCVRT + ENDIF IF(ISO.GT.0) GOTO 100 C C11A* READ TWO-LAYER MOMENTUM FLUX AND CURVATURE ACCELERATION @@ -229,9 +251,11 @@ C CORRECTION FACTORS CALL SEEK('C11A') READ(1,*,IOSTAT=ISO) ICK2COR,CK2UUM,CK2VVM,CK2UVM,CK2UUC, & CK2VVC,CK2UVC,CK2FCX,CK2FCY + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ICK2COR,CK2UUM,CK2VVM,CK2UVM,CK2UUC, & CK2VVC,CK2UVC,CK2FCX,CK2FCY + ENDIF IF(ISO.GT.0) GOTO 100 IF(ICK2COR.GE.1) THEN IS2LMC=ICK2COR @@ -241,8 +265,10 @@ C11B* READ CORNER CELL BOTTOM STRESS CORRECTION OPTIONS NCARD='11B' CALL SEEK('C11B') READ(1,*,IOSTAT=ISO)ISCORTBC,ISCORTBCD,FSCORTBC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISCORTBC,ISCORTBCD,FSCORTBC + ENDIF IF(ISO.GT.0) GOTO 100 C C12* READ TURBULENT DIFFUSION PARAMETERS @@ -250,9 +276,11 @@ C12* READ TURBULENT DIFFUSION PARAMETERS CALL SEEK('C12') READ(1,*,IOSTAT=ISO) AHO,AHD,AVO,ABO,AVMX,ABMX,VISMUD,AVCON, & ZBRWALL,ISAVBMX,ISFAVB,ISINWV + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) AHO,AHD,AVO,ABO,AVMX,ABMX,VISMUD,AVCON,ZBRWALL, & ISAVBMX,ISFAVB,ISINWV + ENDIF IF(ISO.GT.0) GOTO 100 C C13* READ TURBULENCE CLOSURE PARAMETERS @@ -260,9 +288,11 @@ C13* READ TURBULENCE CLOSURE PARAMETERS CALL SEEK('C13') READ(1,*,IOSTAT=ISO) VKC,CTURB,CTURB2B,CTE1,CTE2,CTE3,QQMIN, & QQLMIN,DMLMIN + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) VKC,CTURB,CTURB2B,CTE1,CTE2,CTE3,QQMIN, & QQLMIN,DMLMIN + ENDIF IF(ISO.GT.0) GOTO 100 C C14* READ TIDAL & ATMOSPHERIC FORCING, GROUND WATER @@ -271,9 +301,11 @@ C AND SUBGRID CHANNEL PARAMETERS CALL SEEK('C14') READ(1,*,IOSTAT=ISO) MTIDE,NWSER,NASER,ISGWIT,ISCHAN,ISWAVE, & ITIDASM,ISPERC,ISBODYF,ISPNHYDS + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) MTIDE,NWSER,NASER,ISGWIT,ISCHAN,ISWAVE,ITIDASM, & ISPERC,ISBODYF,ISPNHYDS + ENDIF ISWCBL=0 ISWVSD=0 IF(ISO.GT.0) GOTO 100 @@ -291,8 +323,10 @@ C15* READ PERIODIC FORCING (TIDAL) CONSTITUENT SYMBOLS AND PERIODS CALL SEEK('C15') DO M=1,MTIDE READ(1,*,IOSTAT=ISO) SYMBOL(M),TCP(M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) SYMBOL(M),TCP(M) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -302,10 +336,12 @@ C16* READ SURFACE ELEVATION OR PRESSURE BOUNDARY CONDITION PARAMETERS CALL SEEK('C16') READ(1,*,IOSTAT=ISO) NPBS,NPBW,NPBE,NPBN,NPFOR,NPFORT, & NPSER,PDGINIT + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) NPBS,NPBW,NPBE,NPBN,NPFOR,NPFORT,NPSER,PDGINIT + ENDIF IF(ISO.GT.0) GOTO 100 - IF(NPFORT.GE.1.AND.DEBUG)THEN + IF(NPFORT.GE.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN OPEN(2,FILE='TIDALBC.OUT') CLOSE(2,STATUS='DELETE') OPEN(2,FILE='TIDALBC.OUT') @@ -319,29 +355,35 @@ C17* READ PERIODIC FORCING (TIDAL) SURFACE ELEVATION OR DO M=1,MTIDE IF(NPFORT.EQ.0)THEN READ(1,*,IOSTAT=ISO)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M) + ENDIF IF(ISO.GT.0) GOTO 100 ELSE READ(1,*,IOSTAT=ISO)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M) RAD=PI2*PFPH(NP,M)/TCP(M) CPFAM0(NP,M)=PFAM(NP,M)*COS(RAD) SPFAM0(NP,M)=PFAM(NP,M)*SIN(RAD) + IF(MYRANK.EQ.0)THEN WRITE(2,2068)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M), & CPFAM0(NP,M),SPFAM0(NP,M) WRITE(7,1002)NCARD WRITE(7,*)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M), & CPFAM0(NP,M),SPFAM0(NP,M) + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M) RAD=PI2*PFPH(NP,M)/TCP(M) CPFAM1(NP,M)=PFAM(NP,M)*COS(RAD)-CPFAM0(NP,M) SPFAM1(NP,M)=PFAM(NP,M)*SIN(RAD)-SPFAM0(NP,M) + IF(MYRANK.EQ.0)THEN WRITE(2,2068)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M), & CPFAM1(NP,M),SPFAM1(NP,M) WRITE(7,1002)NCARD WRITE(7,*)NDUM,CDUM,PFAM(NP,M),PFPH(NP,M), & CPFAM1(NP,M),SPFAM1(NP,M) + ENDIF CPFAM2(NP,M)=0.0 SPFAM2(NP,M)=0.0 ENDIF @@ -358,8 +400,10 @@ C ON SOUTH OPEN BOUNDARIES IF(NPFORT.EQ.0)THEN DO L=1,NPBS READ(1,*,IOSTAT=ISO)IPBS(L),JPBS(L),ISPBS(L),NPFORS,NPSERS(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBS(L),JPBS(L),ISPBS(L),NPFORS,NPSERS(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE IF(NPFORS.EQ.0) EXIT @@ -373,16 +417,20 @@ C ON SOUTH OPEN BOUNDARIES DO L=1,NPBS READ(1,*,IOSTAT=ISO) IPBS(L),JPBS(L),ISPBS(L),NPFORS, & NPSERS(L),TPCOORDS(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBS(L),JPBS(L),ISPBS(L),NPFORS,NPSERS(L), & TPCOORDS(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE PCBS(L,M)=CPFAM0(NPFORS,M)+TPCOORDS(L)*CPFAM1(NPFORS,M) & +TPCOORDS(L)*TPCOORDS(L)*CPFAM2(NPFORS,M) PSBS(L,M)=SPFAM0(NPFORS,M)+TPCOORDS(L)*SPFAM1(NPFORS,M) & +TPCOORDS(L)*TPCOORDS(L)*SPFAM2(NPFORS,M) + IF(MYRANK.EQ.0)THEN WRITE(2,2069)L,SYMBOL(M),PCBS(L,M),PSBS(L,M),IPBS(L),JPBS(L) + ENDIF PCBS(L,M)=G*PCBS(L,M) PSBS(L,M)=G*PSBS(L,M) ENDDO @@ -400,8 +448,10 @@ C ON WEST OPEN BOUNDARIES IF(NPFORT.EQ.0)THEN DO L=1,NPBW READ(1,*,IOSTAT=ISO)IPBW(L),JPBW(L),ISPBW(L),NPFORW,NPSERW(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBW(L),JPBW(L),ISPBW(L),NPFORW,NPSERW(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE IF(NPFORW.EQ.0) EXIT @@ -415,16 +465,20 @@ C ON WEST OPEN BOUNDARIES DO L=1,NPBW READ(1,*,IOSTAT=ISO) IPBW(L),JPBW(L),ISPBW(L),NPFORW, & NPSERW(L),TPCOORDW(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBW(L),JPBW(L),ISPBW(L),NPFORW,NPSERW(L), & TPCOORDW(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE PCBW(L,M)=CPFAM0(NPFORW,M)+TPCOORDW(L)*CPFAM1(NPFORW,M) & +TPCOORDW(L)*TPCOORDW(L)*CPFAM2(NPFORW,M) PSBW(L,M)=SPFAM0(NPFORW,M)+TPCOORDW(L)*SPFAM1(NPFORW,M) & +TPCOORDW(L)*TPCOORDW(L)*SPFAM2(NPFORW,M) + IF(MYRANK.EQ.0)THEN WRITE(2,2069)L,SYMBOL(M),PCBW(L,M),PSBW(L,M),IPBW(L),JPBW(L) + ENDIF PCBW(L,M)=G*PCBW(L,M) PSBW(L,M)=G*PSBW(L,M) ENDDO @@ -440,8 +494,10 @@ C ON EAST OPEN BOUNDARIES IF(NPFORT.EQ.0)THEN DO L=1,NPBE READ(1,*,IOSTAT=ISO)IPBE(L),JPBE(L),ISPBE(L),NPFORE,NPSERE(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBE(L),JPBE(L),ISPBE(L),NPFORE,NPSERE(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE IF(NPFORE.EQ.0) EXIT @@ -455,16 +511,20 @@ C ON EAST OPEN BOUNDARIES DO L=1,NPBE READ(1,*,IOSTAT=ISO) IPBE(L),JPBE(L),ISPBE(L),NPFORE, & NPSERE(L),TPCOORDE(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBE(L),JPBE(L),ISPBE(L),NPFORE,NPSERE(L), & TPCOORDE(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE PCBE(L,M)=CPFAM0(NPFORE,M)+TPCOORDE(L)*CPFAM1(NPFORE,M) & +TPCOORDE(L)*TPCOORDE(L)*CPFAM2(NPFORE,M) PSBE(L,M)=SPFAM0(NPFORE,M)+TPCOORDE(L)*SPFAM1(NPFORE,M) & +TPCOORDE(L)*TPCOORDE(L)*SPFAM2(NPFORE,M) + IF(MYRANK.EQ.0)THEN WRITE(2,2069)L,SYMBOL(M),PCBE(L,M),PSBE(L,M),IPBE(L),JPBE(L) + ENDIF PCBE(L,M)=G*PCBE(L,M) PSBE(L,M)=G*PSBE(L,M) ENDDO @@ -480,8 +540,10 @@ C ON NORTH OPEN BOUNDARIES IF(NPFORT.EQ.0)THEN DO L=1,NPBN READ(1,*,IOSTAT=ISO)IPBN(L),JPBN(L),ISPBN(L),NPFORN,NPSERN(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBN(L),JPBN(L),ISPBN(L),NPFORN,NPSERN(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE IF(NPFORN.EQ.0) EXIT @@ -495,16 +557,20 @@ C ON NORTH OPEN BOUNDARIES DO L=1,NPBN READ(1,*,IOSTAT=ISO) IPBN(L),JPBN(L),ISPBN(L),NPFORN, & NPSERN(L),TPCOORDN(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IPBN(L),JPBN(L),ISPBN(L),NPFORN,NPSERN(L), & TPCOORDN(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO M=1,MTIDE PCBN(L,M)=CPFAM0(NPFORN,M)+TPCOORDN(L)*CPFAM1(NPFORN,M) & +TPCOORDN(L)*TPCOORDN(L)*CPFAM2(NPFORN,M) PSBN(L,M)=SPFAM0(NPFORN,M)+TPCOORDN(L)*SPFAM1(NPFORN,M) & +TPCOORDN(L)*TPCOORDN(L)*SPFAM2(NPFORN,M) + IF(MYRANK.EQ.0)THEN WRITE(2,2069)L,SYMBOL(M),PCBN(L,M),PSBN(L,M),IPBN(L),JPBN(L) + ENDIF PCBN(L,M)=G*PCBN(L,M) PSBN(L,M)=G*PSBN(L,M) ENDDO @@ -527,9 +593,11 @@ C22* READ NUM OF SEDIMENT AMD TOXICS AND NUM OF CONCENTRATION TIME SERIES ! NSED=0 2011.3.14 JGCHO ENDIF ! } 20110127 JGCHO + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) NTOX,NSED,NSND,NCSER(1),NCSER(2),NCSER(3), & NCSER(4),NTOXSER,NSEDSER,NSNDSER,ISSBAL + ENDIF IF(ISO.GT.0) GOTO 100 MTMP=4 DO N=1,NTOX @@ -565,9 +633,11 @@ C23* READ VELOCITY, VOL SOUR/SINK, FLOW CONTROL, & WITHDRAW/RETURN DATA CALL SEEK('C23') READ(1,*,IOSTAT=ISO) NVBS,NUBW,NUBE,NVBN,NQSIJ,NQJPIJ,NQSER,NQCTL, & NQCTLT,NQWR,NQWRSR,ISDIQ + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) NVBS,NUBW,NUBE,NVBN,NQSIJ,NQJPIJ,NQSER,NQCTL, & NQCTLT,NQWR,NQWRSR,ISDIQ + ENDIF IF(ISO.GT.0) GOTO 100 C IF(NQSIJ.GT.0)THEN @@ -578,10 +648,12 @@ C24* READ VOLUMN SOURCE/SINK LOCATIONS, MAGNITUDES, & VOL & CONC SERIES READ(1,*,IOSTAT=ISO)IQS(L),JQS(L),QSSE,NQSMUL(L),NQSMF(L), & NQSERQ(L),NCSERQ(L,1),NCSERQ(L,2),NCSERQ(L,3), & NCSERQ(L,4),NTOXSRQ,NSEDSRQ,NSNDSRQ,QFACTOR(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IQS(L),JQS(L),QSSE,NQSMUL(L),NQSMF(L), & NQSERQ(L),NCSERQ(L,1),NCSERQ(L,2),NCSERQ(L,3), & NCSERQ(L,4),NTOXSRQ,NSEDSRQ,NSNDSRQ,QFACTOR(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO K=1,KC QSS(K,L)=QSSE*DZC(K) @@ -607,8 +679,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NOTX) MMAX=4+NTOX DO L=1,NQSIJ READ(1,*,IOSTAT=ISO) (CQSE(M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQSE(M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 DO MS=1,MMAX DO K=1,KC @@ -625,8 +699,10 @@ C SED(1 TO NSED),SND(1 TO NSND) MMAX=MMAX+NSED+NSND DO L=1,NQSIJ READ(1,*,IOSTAT=ISO) (CQSE(M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQSE(M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 DO MS=MMIN,MMAX DO K=1,KC @@ -644,10 +720,12 @@ C27* READ JET/PLUME SOURCE LOCATIONS AND PARAMETERS READ(1,*,IOSTAT=ISO) IDUM,ICALJP(L),IQJP(L),JQJP(L),KQJP(L), & NPORTJP(L),XJETL(L),YJETL(L),ZJET(L),PHJET(L),THJET(L), & DJET(L),CFRD(L),DJPER(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IDUM,ICALJP(L),IQJP(L),JQJP(L),KQJP(L), & NPORTJP(L),XJETL(L),YJETL(L),ZJET(L),PHJET(L),THJET(L), & DJET(L),CFRD(L),DJPER(L) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -658,10 +736,12 @@ C28* READ JET/PLUME SOURCE LOCATIONS AND PARAMETERS READ(1,*,IOSTAT=ISO) IDUM,NJEL(L),NJPMX(L),ISENT(L),ISTJP(L), & NUDJP(L),IOUTJP(L),NZPRJP(L),ISDJP(L),IUPCJP(L), & JUPCJP(L),KUPCJP(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IDUM,NJEL(L),NJPMX(L),ISENT(L),ISTJP(L), & NUDJP(L),IOUTJP(L),NZPRJP(L),ISDJP(L),IUPCJP(L), & JUPCJP(L),KUPCJP(L) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -672,10 +752,12 @@ C29* READ ADDITIONAL JET/PLUME PARAMETERS READ(1,*,IOSTAT=ISO) IDUM,QQCJP(L),NQSERJP(L),NQWRSERJP(L), & NCSERJP(L,1),NCSERJP(L,2),NCSERJP(L,3), & NCSERJP(L,4),NTXSRJP,NSDSRJP,NSNSRJP + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IDUM,QQCJP(L),NQSERJP(L),NQWRSERJP(L), & NCSERJP(L,1),NCSERJP(L,2),NCSERJP(L,3), & NCSERJP(L,4),NTXSRJP,NSDSRJP,NSNSRJP + ENDIF NUDJPC(L)=1 IF(ISO.GT.0) GOTO 100 DO N=1,NTOX @@ -710,8 +792,10 @@ C JET/PLUME SOURCES SAL,TEM,DYE,SFL,TOX(1 TO NOTX) MMAX=4+NTOX DO L=1,NQJPIJ READ(1,*,IOSTAT=ISO) (CQSE(M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQSE(M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 IF(ICALJP(L).EQ.1)THEN DO MS=1,MMAX @@ -738,8 +822,10 @@ C JET/PLUME SOURCES SED(1 TO NSED),SND(1 TO NSND) MMAX=MMAX+NSED+NSND DO L=1,NQJPIJ READ(1,*,IOSTAT=ISO) (CQSE(M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQSE(M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 IF(ICALJP(L).EQ.1)THEN DO MS=MMIN,MMAX @@ -767,10 +853,12 @@ C32* READ SURF ELEV OR PRESS DEPENDENT FLOW CONTROL STRUCTURE INFO READ(1,*,IOSTAT=ISO)IQCTLU(L),JQCTLU(L),IQCTLD(L),JQCTLD(L), & NQCTYP(L),NQCTLQ(L),NQCMUL(L),NQCMFU(L), & NQCMFD(L),BQCMFU(L),BQCMFD(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IQCTLU(L),JQCTLU(L),IQCTLD(L),JQCTLD(L), & NQCTYP(L),NQCTLQ(L),NQCMUL(L),NQCMFU(L), & NQCMFD(L),BQCMFU(L),BQCMFD(L) + ENDIF IF(ISO.GT.0) GOTO 100 DO K=1,KC QCTLTO(K,L)=0. @@ -788,11 +876,13 @@ C33* READ FLOW WITHDRAWAL, HEAT OR MATERIAL ADDITION, FLOW RETURN DATA & IQWRD(L),JQWRD(L),KQWRD(L),QWR(L), & NQWRSERQ(L),NQWRMFU(L),NQWRMFD(L),BQWRMFU(L),BQWRMFD(L), & ANGWRMFD(L) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IQWRU(L),JQWRU(L),KQWRU(L), & IQWRD(L),JQWRD(L),KQWRD(L),QWR(L), & NQWRSERQ(L),NQWRMFU(L),NQWRMFD(L),BQWRMFU(L),BQWRMFD(L), & ANGWRMFD(L) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -803,8 +893,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NQWR READ(1,*,IOSTAT=ISO) (CQWR(L,MS),MS=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQWR(L,MS),MS=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -816,8 +908,10 @@ C SED(1 TO NSED),SND(1 TO NSND) MMAX=MMAX+NSED+NSND DO L=1,NQWR READ(1,*,IOSTAT=ISO) (CQWR(L,MS),MS=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CQWR(L,MS),MS=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -828,9 +922,11 @@ C36* SEDIMENT INITIALIZATION AND WATER COLUMN/BED REPRESENTATION OPTIONS CALL SEEK('C36') READ(1,*,IOSTAT=ISO)ISEDINT,ISEDBINT,ISEDWC,ISMUD,ISNDWC,ISEDVW, & ISNDVW,KB,ISDTXBUG + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISEDINT,ISEDBINT,ISEDWC,ISMUD,ISNDWC,ISEDVW, & ISNDVW,KB,ISDTXBUG + ENDIF IF(ISO.GT.0) GOTO 100 C C36A* SEDIMENT INITIALIZATION AND WATER COLUMN/BED REPRESENTATION OPTIONS @@ -838,8 +934,10 @@ C36A* SEDIMENT INITIALIZATION AND WATER COLUMN/BED REPRESENTATION OPTIONS CALL SEEK('C36A') COEFTSBL=4.0 READ(1,*,IOSTAT=ISO)ISBEDSTR,ISBSDFUF,COEFTSBL,VISMUDST + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISBEDSTR,ISBSDFUF,COEFTSBL,VISMUDST + ENDIF IF(ISO.GT.0) GOTO 100 C C36B* SEDIMENT INITIALIZATION AND WATER COLUMN/BED REPRESENTATION OPTIONS @@ -847,9 +945,11 @@ C36B* SEDIMENT INITIALIZATION AND WATER COLUMN/BED REPRESENTATION OPTIONS CALL SEEK('C36B') READ(1,*,IOSTAT=ISO)ISEDAL,ISNDAL,IALTYP,IALSTUP, & ISEDEFF,HBEDAL,COEHEFF,COEHEFF2 + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISEDAL,ISNDAL,IALTYP,IALSTUP, & HBEDAL,COEHEFF,COEHEFF2 + ENDIF IF(ISO.GT.0) GOTO 100 C C37* BED MECHANICAL PROPERTIES PARAMETER SET 1 @@ -857,9 +957,11 @@ C37* BED MECHANICAL PROPERTIES PARAMETER SET 1 CALL SEEK('C37') READ(1,*,IOSTAT=ISO)ISEDDT,IBMECH,IMORPH,HBEDMAX,BEDPORC, & SEDMDMX,SEDMDMN,SEDVDRD,SEDVDRM,SEDVRDT + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISEDDT,IBMECH,IMORPH,HBEDMAX,BEDPORC, & SEDMDMX,SEDMDMN,SEDVDRD,SEDVDRM,SEDVRDT + ENDIF IF(ISO.GT.0) GOTO 100 ISEDDTC=0 IF(IBMECH.EQ.0) THEN @@ -886,8 +988,10 @@ C38* BED MECHANICAL PROPERTIES PARAMETER SET 2 CALL SEEK('C38') READ(1,*,IOSTAT=ISO)IBMECHK,BMECH1,BMECH2,BMECH3,BMECH4,BMECH5, & BMECH6 + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IBMECHK,BMECH1,BMECH2,BMECH3,BMECH4,BMECH5,BMECH6 + ENDIF IF(ISO.GT.0) GOTO 100 ENDIF C @@ -899,9 +1003,11 @@ C39* READ COHESIVE SEDIMENT PARAMETER SET 1 REPEAT DATA LINE NSED TIMES DO N=1,NSED READ(1,*,IOSTAT=ISO)SEDO(N),SEDBO(N),SDEN(N),SSG(N), & WSEDO(N),SEDN(N),SEXP(N),TAUD(N),ISEDSCOR(N) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)SEDO(N),SEDBO(N),SDEN(N),SSG(N), & WSEDO(N),SEDN(N),SEXP(N),TAUD(N) + ENDIF IF(ISO.GT.0) GOTO 100 SEDDIA(N)=0. HADJ=SEDN(1) @@ -914,13 +1020,15 @@ C40* READ COHESIVE SEDIMENT PARAMETER SET 2 REPEAT DATA LINE NSED TIMES DO N=1,NSED READ(1,*,IOSTAT=ISO)IWRSP(N),IWRSPB(N),WRSPO(N),TAUR(N),TAUN(N), & TEXP(N),VDRRSPO(N),COSEDHID(N) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IWRSP(N),IWRSPB(N),WRSPO(N),TAUR(N),TAUN(N),TEXP(N), & VDRRSPO(N),COSEDHID(N) + ENDIF IF(ISO.GT.0) GOTO 100 C IF(N.EQ.1.AND.IWRSP(N).EQ.999) THEN - PRINT *,'READING TAU_CRIT_COH.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TAU_CRIT_COH.INP' OPEN(1001,FILE='TAU_CRIT_COH.INP',STATUS='OLD') DO L = 2, 4393 READ(1001,*,IOSTAT=ISO) (TAUCRCOH(L,K),K=1,10) @@ -932,8 +1040,8 @@ C ! *** PMC - Mass Erosion is not enabled in EFDC at this time, so ensure disabled IF(IWRSPB(N).GT.0)THEN - PRINT *,' *** WARNING: COHESIVE MASS/BULK EROSION IS NOT ENA - &BLED IN EFDC!' + IF(MYRANK.EQ.0) PRINT *,' *** WARNING: COHESIVE MASS/BULK + & EROSION IS NOT ENABLED IN EFDC!' IWRSPB(N)=0 ENDIF ENDDO @@ -951,9 +1059,11 @@ C41* READ NONCOHESIVE SEDIMENT PARAMETER SET 1 REPEAT DATA LINE NSND TIMES IF(WSEDO(N).LT.0.0)THEN WSEDO(N)=SETSTVEL(SEDDIA(N),SSG(N)) ENDIF + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)SEDO(N),SEDBO(N),SDEN(N),SSG(N),SEDDIA(N), & WSEDO(N),SEDN(N),SEXP(N),TAUD(N),ISEDSCOR(N) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -980,9 +1090,11 @@ C C C IF TAUR(N) IS NEGATIVE, COMPUTE USING VAN RIJN'S FORMULA C + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISNDEQ(N),TAUR(N),TAUN(N),TCSHIELDS(N),SEDDIA(N), & SSG(N),DSTR,USTR + ENDIF IF(ISO.GT.0) GOTO 100 IWRSP(N)=0 WRSPO(N)=0.0 @@ -993,9 +1105,11 @@ C42A* READ NONCOHESIVE SEDIMENT BED LOAD PARAMETERS CALL SEEK('C42A') READ(1,*,IOSTAT=ISO)ISBDLDBC,SBDLDA,SBDLDB,SBDLDG1, & SBDLDG2,SBDLDG3,SBDLDG4,SBDLDP,ISBLFUC,BLBSNT + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISBDLDBC,SBDLDA,SBDLDB,SBDLDG1,SBDLDG2,SBDLDG3, & SBDLDG4,SBDLDP,ISBLFUC,BLBSNT + ENDIF IF(ISO.GT.0) GOTO 100 ENDIF C @@ -1007,9 +1121,11 @@ C43* READ TOXIC CONTAMINANT INITIAL CONDITIONS AND PARAMETERS DO NT=1,NTOX READ(1,*,IOSTAT=ISO)NDUM,ITXINT(NT),ITXBDUT(NT),TOXINTW(NT), & TOXINTB(NT),RKTOXW(NT),TKTOXW(NT),RKTOXB(NT),TRTOXB(NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM,ITXINT(NT),ITXBDUT(NT),TOXINTW(NT), & TOXINTB(NT),RKTOXW(NT),TKTOXW(NT),RKTOXB(NT),TRTOXB(NT) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1022,10 +1138,12 @@ C44* READ TOXIC CONTAMINANT PARAMETERS READ(1,*,IOSTAT=ISO)NDUM,ISTOC(NT),VOLTOX(NT),RMOLTX(NT), & RKTOXP(NT),SKTOXP(NT),DIFTOX(NT), & DIFTOXS(NT),PDIFTOX (NT),DPDIFTOX(NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM,ISTOC(NT),VOLTOX(NT),RMOLTX(NT),RKTOXP(NT), & SKTOXP(NT),DIFTOX(NT), & DIFTOXS(NT),PDIFTOX (NT),DPDIFTOX(NT) + ENDIF IF(ISO.GT.0) GOTO 100 ISDIFBW(NT)=0 IF(DIFTOXS(NT).LT.0.0)THEN @@ -1045,10 +1163,12 @@ C45* READ TOXIC CONTAMINANT-SEDIMENT INTERACTION PARAMETERS READ(1,*,IOSTAT=ISO)NDUM1,NDUM2, & ITXPARW(N,NT),TOXPARW(N,NT),CONPARW(N,NT), & ITXPARB(N,NT),TOXPARB(N,NT),CONPARB(N,NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM1,NDUM2, & ITXPARW(N,NT),TOXPARW(N,NT),CONPARW(N,NT), & ITXPARB(N,NT),TOXPARB(N,NT),CONPARB(N,NT) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1058,10 +1178,12 @@ C45* READ TOXIC CONTAMINANT-SEDIMENT INTERACTION PARAMETERS READ(1,*,IOSTAT=ISO)NDUM1,NDUM2, & ITXPARW(N,NT),TOXPARW(N,NT),CONPARW(N,NT), & ITXPARB(N,NT),TOXPARB(N,NT),CONPARB(N,NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM1,NDUM2, & ITXPARW(N,NT),TOXPARW(N,NT),CONPARW(N,NT), & ITXPARB(N,NT),TOXPARB(N,NT),CONPARB(N,NT) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1074,9 +1196,11 @@ C45A* READ TOXIC CONTAMINANT ORGANIC CARBON PARAMETERS IF(IWRSP(1).LT.90.AND.NTOX.GT.0)THEN ! SEDZLJ edit READ(1,*,IOSTAT=ISO)ISTDOCW,ISTPOCW,ISTDOCB,ISTPOCB, & STDOCWC,STPOCWC,STDOCBC,STPOCBC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISTDOCW,ISTPOCW,ISTDOCB,ISTPOCB, & STDOCWC,STPOCWC,STDOCBC,STPOCBC + ENDIF IF(ISO.GT.0) GOTO 100 ENDIF C @@ -1088,18 +1212,22 @@ C45B* READ TOXIC CONTAMINANT-ORGANIC CARBON INTERACTION PARAMETERS READ(1,*,IOSTAT=ISO)NDUM1,NDUM2, & ITXPARWC(1,NT),TOXPARWC(1,NT),CONPARWC(1,NT), & ITXPARBC(1,NT),TOXPARBC(1,NT),CONPARBC(1,NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM1,NDUM2, & ITXPARWC(1,NT),TOXPARWC(1,NT),CONPARWC(1,NT), & ITXPARBC(1,NT),TOXPARBC(1,NT),CONPARBC(1,NT) + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)NDUM1,NDUM2, & ITXPARWC(2,NT),TOXPARWC(2,NT),CONPARWC(2,NT), & ITXPARBC(2,NT),TOXPARBC(2,NT),CONPARBC(2,NT) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)NDUM1,NDUM2, & ITXPARWC(2,NT),TOXPARWC(2,NT),CONPARWC(2,NT), & ITXPARBC(2,NT),TOXPARBC(2,NT),CONPARBC(2,NT) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1107,13 +1235,17 @@ C C45C* READ TOXIC CONTAMINANT-ORGANIC CARBON WATER COLUMN POC FRACTIONS NCARD='45C' CALL SEEK('C45C') + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD + ENDIF NTMP=NSED+NSND IF(IWRSP(1).LT.90)THEN ! *** SEDZLJ Edit DO NT=1,NTOX READ(1,*,IOSTAT=ISO)NDUM1,(FPOCWST(NS,NT),NS=1,NTMP) IF(ISO.GT.0) GOTO 100 + IF(MYRANK.EQ.0)THEN WRITE(7,*)NDUM1,(FPOCWST(NS,NT),NS=1,NTMP) + ENDIF ENDDO ENDIF C @@ -1143,13 +1275,17 @@ C C45D* READ TOXIC CONTAMINANT-ORGANIC CARBON SED BED POC FRACTIONS NCARD='45D' CALL SEEK('C45D') + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD + ENDIF NTMP=NSED+NSND IF(IWRSP(1).LT.90)THEN ! *** SEDZLJ Edit DO NT=1,NTOX READ(1,*,IOSTAT=ISO)NDUM1,(FPOCBST(NS,NT),NS=1,NTMP) IF(ISO.GT.0) GOTO 100 + IF(MYRANK.EQ.0)THEN WRITE(7,*)NDUM1,(FPOCBST(NS,NT),NS=1,NTMP) + ENDIF ENDDO ENDIF C @@ -1181,8 +1317,10 @@ C46* READ BUOYANCY, TEMPERATURE, DYE DATA AND CONCENTRATION BC DATA NCARD='46' CALL SEEK('C46') READ(1,*,IOSTAT=ISO)BSC,TEMO,HEQT,RKDYE,NCBS,NCBW,NCBE,NCBN + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)BSC,TEMO,HEQT,RKDYE,NCBS,NCBW,NCBE,NCBN + ENDIF IF(ISO.GT.0) GOTO 100 IF(BSC.EQ.2)THEN BSC=1. @@ -1205,10 +1343,12 @@ C47* READ LOCATIONS OF CONC BC'S ON SOUTH BOUNDARIES READ(1,*,IOSTAT=ISO) ICBS(L),JCBS(L),NTSCRS(L), & NCSERS(L,1),NCSERS(L,2),NCSERS(L,3),NCSERS(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ICBS(L),JCBS(L),NTSCRS(L), & NCSERS(L,1),NCSERS(L,2),NCSERS(L,3),NCSERS(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + ENDIF IF(ISO.GT.0) GOTO 100 DO N=1,NTOX M=MSVTOX(N) @@ -1231,8 +1371,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBS READ(1,*,IOSTAT=ISO) (CBS(L,1,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBS(L,1,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1244,8 +1386,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBS READ(1,*,IOSTAT=ISO) (CBS(L,1,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBS(L,1,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1256,8 +1400,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBS READ(1,*,IOSTAT=ISO) (CBS(L,2,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBS(L,2,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1269,8 +1415,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBS READ(1,*,IOSTAT=ISO) (CBS(L,2,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBS(L,2,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1283,10 +1431,12 @@ C52* READ LOCATIONS OF CONC BC'S ON WEST BOUNDARIES READ(1,*,IOSTAT=ISO) ICBW(L),JCBW(L),NTSCRW(L), & NCSERW(L,1),NCSERW(L,2),NCSERW(L,3),NCSERW(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ICBW(L),JCBW(L),NTSCRW(L), & NCSERW(L,1),NCSERW(L,2),NCSERW(L,3),NCSERW(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + ENDIF IF(ISO.GT.0) GOTO 100 DO N=1,NTOX M=MSVTOX(N) @@ -1309,8 +1459,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBW READ(1,*,IOSTAT=ISO) (CBW(L,1,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBW(L,1,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1322,8 +1474,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBW READ(1,*,IOSTAT=ISO) (CBW(L,1,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBW(L,1,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1334,8 +1488,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBW READ(1,*,IOSTAT=ISO) (CBW(L,2,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBW(L,2,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1347,8 +1503,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBW READ(1,*,IOSTAT=ISO) (CBW(L,2,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBW(L,2,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1361,10 +1519,12 @@ C57* READ LOCATIONS OF CONC BC'S ON EAST BOUNDARIES READ(1,*,IOSTAT=ISO) ICBE(L),JCBE(L),NTSCRE(L), & NCSERE(L,1),NCSERE(L,2),NCSERE(L,3),NCSERE(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ICBE(L),JCBE(L),NTSCRE(L), & NCSERE(L,1),NCSERE(L,2),NCSERE(L,3),NCSERE(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + ENDIF IF(ISO.GT.0) GOTO 100 DO N=1,NTOX M=MSVTOX(N) @@ -1387,8 +1547,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBE READ(1,*,IOSTAT=ISO) (CBE(L,1,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBE(L,1,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1400,8 +1562,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBE READ(1,*,IOSTAT=ISO) (CBE(L,1,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBE(L,1,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1412,8 +1576,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBE READ(1,*,IOSTAT=ISO) (CBE(L,2,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBE(L,2,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1425,8 +1591,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBE READ(1,*,IOSTAT=ISO) (CBE(L,2,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBE(L,2,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1439,10 +1607,12 @@ C62* READ LOCATIONS OF CONC BC'S ON NORTH BOUNDARIES READ(1,*,IOSTAT=ISO) ICBN(L),JCBN(L),NTSCRN(L), & NCSERN(L,1),NCSERN(L,2),NCSERN(L,3),NCSERN(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ICBN(L),JCBN(L),NTSCRN(L), & NCSERN(L,1),NCSERN(L,2),NCSERN(L,3),NCSERN(L,4), & NTOXSRC,NSEDSRC,NSNDSRC + ENDIF IF(ISO.GT.0) GOTO 100 DO N=1,NTOX M=MSVTOX(N) @@ -1465,8 +1635,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBN READ(1,*,IOSTAT=ISO) (CBN(L,1,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBN(L,1,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1478,8 +1650,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBN READ(1,*,IOSTAT=ISO) (CBN(L,1,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBN(L,1,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1490,8 +1664,10 @@ C SAL,TEM,DYE,SFL,TOX(1 TO NTOX) MMAX=4+NTOX DO L=1,NCBN READ(1,*,IOSTAT=ISO) (CBN(L,2,M),M=1,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBN(L,2,M),M=1,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1503,8 +1679,10 @@ C SED(1 TO NSED),SND(1,NSND) MMAX=MMAX+NSED+NSND DO L=1,NCBN READ(1,*,IOSTAT=ISO) (CBN(L,2,M),M=MMIN,MMAX) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) (CBN(L,2,M),M=MMIN,MMAX) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1513,8 +1691,10 @@ C66A* READ CONCENTRATION DATA ASSIMILATION PARAMETERS NCARD='66A' CALL SEEK('C66A') READ(1,*,IOSTAT=ISO) NLCDA,TSCDA,(ISCDA(K),K=1,7) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) NLCDA,TSCDA,(ISCDA(K),K=1,7) + ENDIF IF(ISO.GT.0) GOTO 100 C C66B* READ CONCENTRATION DATA ASSIMILATION LOCATIONS AND @@ -1522,12 +1702,16 @@ C SERIES IDENTIFIERS IF(NLCDA.GT.0)THEN NCARD='66B' CALL SEEK('C66B') + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD + ENDIF DO L=1,NLCDA READ(1,*,IOSTAT=ISO) ITPCDA(L),ICDA(L),JCDA(L), & ICCDA(L),JCCDA(L),(NCSERA(L,K),K=1,7) + IF(MYRANK.EQ.0)THEN WRITE(7,*) ITPCDA(L),ICDA(L),JCDA(L), & ICCDA(L),JCCDA(L),(NCSERA(L,K),K=1,7) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1537,9 +1721,11 @@ C67* READ NEUTRALLY BUOYANT PARTICLE DRIFTER DATA CALL SEEK('C67') READ(1,*,IOSTAT=ISO) ISPD,NPD,NPDRT,NWPD,ISLRPD,ILRPD1,ILRPD2, & JLRPD1, JLRPD2, MLRPDRT,IPLRPD + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISPD,NPD,NPDRT,NWPD,ISLRPD,ILRPD1,ILRPD2, & JLRPD1, JLRPD2, MLRPDRT,IPLRPD + ENDIF IF(ISO.GT.0) GOTO 100 C @@ -1549,8 +1735,10 @@ C68* READ NEUTRALLY BUOYANT PARTICLE INITIAL POSITIONS CALL SEEK('C68') DO NP=1,NPD READ(1,*,IOSTAT=ISO) RI(NP),RJ(NP),RK(NP) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) RI(NP),RJ(NP),RK(NP) + ENDIF ENDDO ENDIF C @@ -1558,8 +1746,10 @@ C69* CONSTANTS FOR LONGITUDE AND LATITUDE OF CELL CENTERS NCARD='69' CALL SEEK('C69') READ(1,*,IOSTAT=ISO) CDLON1,CDLON2,CDLON3,CDLAT1,CDLAT2,CDLAT3 + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) CDLON1,CDLON2,CDLON3,CDLAT1,CDLAT2,CDLAT3 + ENDIF IF(ISO.GT.0) GOTO 100 C C70* CONTROLS FOR WRITING ASCII OR BINARY DUMP FILES @@ -1567,9 +1757,11 @@ C70* CONTROLS FOR WRITING ASCII OR BINARY DUMP FILES CALL SEEK('C70') READ(1,*,IOSTAT=ISO)ISDUMP,ISADMP,NSDUMP,TSDUMP,TEDUMP,ISDMPP, & ISDMPU,ISDMPW,ISDMPT,IADJDMP + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISDUMP,ISADMP,NSDUMP,TSDUMP,TEDUMP,ISDMPP, & ISDMPU,ISDMPW,ISDMPT,IADJDMP + ENDIF IF(ISO.GT.0) GOTO 100 JSDUMP=1 NCDUMP=1 @@ -1579,8 +1771,10 @@ C71* CONTROLS FOR HORIZONTAL PLANE SCALAR FIELD CONTOURING CALL SEEK('C71') DO N=1,7 READ(1,*,IOSTAT=ISO) ISSPH(N),NPSPH(N),ISRSPH(N),ISPHXY(N) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISSPH(N),NPSPH(N),ISRSPH(N),ISPHXY(N) + ENDIF ENDDO IF(ISO.GT.0) GOTO 100 ISSPH(8)=0 @@ -1599,9 +1793,11 @@ C71A* CONTROLS FOR HORIZONTAL PLANE SEDIMENT BED PROPERTIES CALL SEEK('C71A') READ(1,*,IOSTAT=ISO) ISBPH,ISBEXP,NPBPH,ISRBPH,ISBBDN,ISBLAY, & ISBPOR,ISBSED,ISBSND,ISBVDR,ISBARD + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISBPH,ISBEXP,NPBPH,ISRBPH,ISBBDN,ISBLAY, & ISBPOR,ISBSED,ISBSND,ISBVDR,ISBARD + ENDIF IF(ISO.GT.0) GOTO 100 IF(ISBEXP.GE.1) NPSPH(8)=MAX(NPSPH(8),NPBPH) JSBPH=1 @@ -1611,8 +1807,10 @@ C71B* CONTROLS FOR FOOD CHAIN MODEL OUTPUT NCARD='71B' CALL SEEK('C71B') READ(1,*,IOSTAT=ISO) ISFDCH,NFDCHZ,HBFDCH,TFCAVG + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISFDCH,NFDCHZ,HBFDCH,TFCAVG + ENDIF IF(ISO.GT.0) GOTO 100 C C72* CONTROLS FOR HORIZONTAL PLANE SURFACE ELEVATION OR PRESSURE @@ -1620,16 +1818,20 @@ C72* CONTROLS FOR HORIZONTAL PLANE SURFACE ELEVATION OR PRESSURE NCARD='72' CALL SEEK('C72') READ(1,*,IOSTAT=ISO) ISPPH,NPPPH,ISRPPH,IPPHXY + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISPPH,NPPPH,ISRPPH,IPPHXY + ENDIF IF(ISO.GT.0) GOTO 100 C C73* CONTROLS FOR HORIZONTAL PLANE VELOCITY PLOTTING NCARD='73' CALL SEEK('C73') READ(1,*,IOSTAT=ISO) ISVPH,NPVPH,ISRVPH,IVPHXY + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISVPH,NPVPH,ISRVPH,IVPHXY + ENDIF IF(ISO.GT.0) GOTO 100 C C74* CONTROLS FOR VERTICAL PLANE SCALAR FIELD CONTOURING @@ -1637,17 +1839,21 @@ C74* CONTROLS FOR VERTICAL PLANE SCALAR FIELD CONTOURING CALL SEEK('C74') READ(1,*,IOSTAT=ISO) ISECSPV,NPSPV(1),ISSPV(1),ISRSPV(1), & ISHPLTV(1) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISECSPV,NPSPV(1),ISSPV(1),ISRSPV(1), & ISHPLTV(1) + ENDIF SHPLTV(1)=FLOAT(ISHPLTV(1)) SBPLTV(1)=1.0-SHPLTV(1) DO N=2,7 READ(1,*,IOSTAT=ISO) IDUMMY,NPSPV(N),ISSPV(N),ISRSPV(N), & ISHPLTV(N) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) IDUMMY,NPSPV(N),ISSPV(N),ISRSPV(N), & ISHPLTV(N) + ENDIF SHPLTV(N)=FLOAT(ISHPLTV(N)) SBPLTV(N)=1.0-SHPLTV(N) ENDDO @@ -1659,8 +1865,10 @@ C75* MORE CONTROLS FOR VERTICAL PLANE SCALAR FIELD CONTOURING CALL SEEK('C75') DO IS=1,ISECSPV READ(1,*,IOSTAT=ISO) DUM,NIJSPV(IS),CCTITLE(10+IS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) DUM,NIJSPV(IS),CCTITLE(10+IS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1670,8 +1878,10 @@ C76* I,J LOCATIONS DEFINING VERTICAL PLANE FOR CONTOURING DO IS=1,ISECSPV DO NPP=1,NIJSPV(IS) READ(1,*,IOSTAT=ISO) DUM,ISPV(NPP,IS),JSPV(NPP,IS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) DUM,ISPV(NPP,IS),JSPV(NPP,IS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDDO @@ -1680,8 +1890,10 @@ C NCARD='77' CALL SEEK('C77') READ(1,*,IOSTAT=ISO) ISECVPV,NPVPV,ISVPV,ISRVPV + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISECVPV,NPVPV,ISVPV,ISRVPV + ENDIF IF(ISO.GT.0) GOTO 100 C IF(ISECVPV.GT.0)THEN @@ -1689,8 +1901,10 @@ C CALL SEEK('C78') DO IS=1,ISECVPV READ(1,*,IOSTAT=ISO) DUM,NIJVPV(IS),ANGVPV(IS),CVTITLE(10+IS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) DUM,NIJVPV(IS),ANGVPV(IS),CVTITLE(10+IS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1699,8 +1913,10 @@ C DO IS=1,ISECVPV DO NPP=1,NIJVPV(IS) READ(1,*,IOSTAT=ISO) DUM,IVPV(NPP,IS),JVPV(NPP,IS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) DUM,IVPV(NPP,IS),JVPV(NPP,IS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDDO @@ -1710,9 +1926,11 @@ C CALL SEEK('C80') READ(1,*,IOSTAT=ISO)IS3DO,ISR3DO,NP3DO,KPC,NWGG,I3DMIN,I3DMAX, & J3DMIN,J3DMAX,I3DRW,SELVMAX,BELVMIN + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IS3DO,ISR3DO,NP3DO,KPC,NWGG,I3DMIN,I3DMAX, & J3DMIN,J3DMAX,I3DRW,SELVMAX,BELVMIN + ENDIF IF(ISO.GT.0) GOTO 100 NCALL3D=0 NRCAL3D=0 @@ -1720,47 +1938,67 @@ C NCARD='81' CALL SEEK('C81') READ(1,*,IOSTAT=ISO)CDUM,IS3DUUU,JS3DUUU,UUU3DMA,UUU3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DUUU,JS3DUUU,UUU3DMA,UUU3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DVVV,JS3DVVV,VVV3DMA,VVV3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DVVV,JS3DVVV,VVV3DMA,VVV3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DWWW,JS3DWWW,WWW3DMA,WWW3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DWWW,JS3DWWW,WWW3DMA,WWW3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DSAL,JS3DSAL,SAL3DMA,SAL3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DSAL,JS3DSAL,SAL3DMA,SAL3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DTEM,JS3DTEM,TEM3DMA,TEM3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DTEM,JS3DTEM,TEM3DMA,TEM3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DDYE,JS3DDYE,DYE3DMA,DYE3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DDYE,JS3DDYE,DYE3DMA,DYE3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DSED,JS3DSED,SED3DMA,SED3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DSED,JS3DSED,SED3DMA,SED3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DSND,JS3DSND,SND3DMA,SND3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DSND,JS3DSND,SND3DMA,SND3DMI + ENDIF IF(ISO.GT.0) GOTO 100 READ(1,*,IOSTAT=ISO)CDUM,IS3DTOX,JS3DTOX,TOX3DMA,TOX3DMI + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)CDUM,IS3DTOX,JS3DTOX,TOX3DMA,TOX3DMI + ENDIF IF(ISO.GT.0) GOTO 100 C NCARD='82' CALL SEEK('C82') READ(1,*,IOSTAT=ISO) ISLSHA,MLLSHA,NTCLSHA,ISLSTR,ISHTA + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ISLSHA,MLLSHA,NTCLSHA,ISLSTR,ISHTA + ENDIF IF(ISO.GT.0) GOTO 100 C IF(MLLSHA.GT.0)THEN @@ -1769,9 +2007,11 @@ C DO M=1,MLLSHA READ(1,*,IOSTAT=ISO) ILLSHA(M),JLLSHA(M),LSHAP(M),LSHAB(M), & LSHAUE(M),LSHAU(M),CLSL(M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*) ILLSHA(M),JLLSHA(M),LSHAP(M),LSHAB(M), & LSHAUE(M),LSHAU(M),CLSL(M) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1780,9 +2020,11 @@ C CALL SEEK('C84') READ(1,*,IOSTAT=ISO)ISTMSR,MLTMSR,NBTMSR,NSTMSR,NWTMSR,NTSSTSP, & TCTMSR + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISTMSR,MLTMSR,NBTMSR,NSTMSR,NWTMSR,NTSSTSP, & TCTMSR + ENDIF IF(ISO.GT.0) GOTO 100 JSTMSR=1 @@ -1795,8 +2037,10 @@ C CALL SEEK('C85') DO ITSSS=1,NTSSTSP READ(1,*,IOSTAT=ISO)IDUM,MTSSTSP(ITSSS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IDUM,MTSSTSP(ITSSS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO C @@ -1806,9 +2050,11 @@ C DO MTSSS=1,MTSSTSP(ITSSS) READ(1,*,IOSTAT=ISO)IDUM,IDUM,TSSTRT(MTSSS,ITSSS), & TSSTOP(MTSSS,ITSSS) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IDUM,IDUM,TSSTRT(MTSSS,ITSSS), & TSSTOP(MTSSS,ITSSS) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDDO @@ -1821,10 +2067,12 @@ C READ(1,*,IOSTAT=ISO)ILTMSR(M),JLTMSR(M),NTSSSS(M),MTMSRP(M), & MTMSRC(M),MTMSRA(M),MTMSRUE(M),MTMSRUT(M),MTMSRU(M), & MTMSRQE(M),MTMSRQ(M),CLTMSR(M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ILTMSR(M),JLTMSR(M),NTSSSS(M),MTMSRP(M), & MTMSRC(M),MTMSRA(M),MTMSRUE(M),MTMSRUT(M),MTMSRU(M), & MTMSRQE(M),MTMSRQ(M),CLTMSR(M) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1832,8 +2080,10 @@ C NCARD='88' CALL SEEK('C88') READ(1,*,IOSTAT=ISO)ISVSFP,MDVSFP,MLVSFP,TMVSFP,TAVSFP + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)ISVSFP,MDVSFP,MLVSFP,TMVSFP,TAVSFP + ENDIF IF(ISO.GT.0) GOTO 100 JSVSFP=1 C @@ -1842,8 +2092,10 @@ C CALL SEEK('C89') DO M=1,MDVSFP READ(1,*,IOSTAT=ISO)IDUM,DMVSFP(M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IDUM,DMVSFP(M) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1853,8 +2105,10 @@ C CALL SEEK('C90') DO M=1,MLVSFP READ(1,*,IOSTAT=ISO)IDUM,TIMVSFP(M),IVSFP(M),JVSFP(M) + IF(MYRANK.EQ.0)THEN WRITE(7,1002)NCARD WRITE(7,*)IDUM,TIMVSFP(M),IVSFP(M),JVSFP(M) + ENDIF IF(ISO.GT.0) GOTO 100 ENDDO ENDIF @@ -1893,8 +2147,10 @@ C C ** WRITE INPUT ERROR MESSAGES AND TERMINATE RUN C 100 WRITE(6,1001)NCARD + IF(MYRANK.EQ.0)THEN WRITE(8,1001)NCARD WRITE(7,1001)NCARD + ENDIF STOP 2000 CONTINUE @@ -1903,7 +2159,7 @@ C ** NOW REWIND UNIT 1 & READ IN AS CHARACTER TO WRITE TO UNIT 7 C REWIND (1) 21 READ(1,22,END=24) TEXT - WRITE (7,23) TEXT + IF(MYRANK.EQ.0)WRITE (7,23) TEXT GOTO 21 24 CONTINUE CLOSE(1) @@ -1921,7 +2177,7 @@ C !} GEOSR, Check file WINDCOEFF.INP exist jgcho 2016.10.21 !{GeoSR, 2014.07.04 YSSONG, WIND DRAG COEFF. IF(ISWIND.EQ.1)THEN - PRINT *,'READING WINDCOEFF.INP' + IF(MYRANK.EQ.0) PRINT *,'READING WINDCOEFF.INP' OPEN(1,FILE='WINDCOEFF.INP',STATUS='UNKNOWN') DO IS=1,16 @@ -1945,7 +2201,8 @@ C CALL INPUT_WINDCOEF !! INPUT FOR WINDCOEFF.INP BY GEOSR GOTO 9883 - 9886 PRINT *,'READ ERROR FOR FILE WINDCOEFF.INP_CSG-01' + 9886 CONTINUE + IF(MYRANK.EQ.0) PRINT *,'READ ERROR FOR FILE WINDCOEFF.INP_CSG-01' STOP 9883 CONTINUE @@ -1953,7 +2210,7 @@ C CALL INPUT_WINDCOEF !! INPUT FOR WINDCOEFF.INP BY GEOSR C C ** READ CELL TYPES FROM FILES CELL.INP C - PRINT *,'READING CELL.INP' + IF(MYRANK.EQ.0) PRINT *,'READING CELL.INP' OPEN(1,FILE='CELL.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES AND DETERMINE FILE FORMAT @@ -1982,13 +2239,13 @@ C JF=JT JLAST=JT+JACROSS-1 IF(JLAST.GT.JC) JLAST=JC - WRITE (7,8)JF,JLAST + IF(MYRANK.EQ.0)WRITE (7,8)JF,JLAST DO I=1,IC READ(1,6,IOSTAT=ISO) (IJCT(I,J),J=JF,JLAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,16) (IJCT(I,J),J=JF,JLAST) + IF(MYRANK.EQ.0)WRITE (7,16) (IJCT(I,J),J=JF,JLAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDDO ELSE C @@ -1998,24 +2255,26 @@ C IFIRST=IT ILAST=IT+IACROSS-1 IF(ILAST.GT.IC) ILAST=IC - WRITE (7,88)IFIRST,ILAST + IF(MYRANK.EQ.0)WRITE (7,88)IFIRST,ILAST DO J=JC,1,-1 READ(1,66,IOSTAT=ISO)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,166)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) + IF(MYRANK.EQ.0) + & WRITE (7,166)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDDO ELSE IFIRST=1 ILAST=IC - WRITE (7,88)IFIRST,ILAST + IF(MYRANK.EQ.0)WRITE (7,88)IFIRST,ILAST DO J=JC,1,-1 READ(1,66,IOSTAT=ISO)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,166)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) + IF(MYRANK.EQ.0) + & WRITE (7,166)ADUMMY,(IJCT(I,J),I=IFIRST,ILAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDIF ENDIF CLOSE(1) @@ -2024,7 +2283,7 @@ C C C----------------------------------------------------------------------C C - PRINT *,'READING CELLLT.INP' + IF(MYRANK.EQ.0) PRINT *,'READING CELLLT.INP' OPEN(1,FILE='CELLLT.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES AND DETERMINE FILE FORMAT @@ -2052,13 +2311,13 @@ C ** READ OLD FILE FORMAT JF=JT JLAST=JT+JACROSS-1 IF(JLAST.GT.JC) JLAST=JC - WRITE (7,8)JF,JLAST + IF(MYRANK.EQ.0)WRITE (7,8)JF,JLAST DO I=1,IC READ(1,6,IOSTAT=ISO) (IJCTLT(I,J),J=JF,JLAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,16) (IJCTLT(I,J),J=JF,JLAST) + IF(MYRANK.EQ.0)WRITE (7,16) (IJCTLT(I,J),J=JF,JLAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDDO ELSE @@ -2069,24 +2328,26 @@ C ** READ NEW FILE FORMAT IFIRST=IT ILAST=IT+IACROSS-1 IF(ILAST.GT.IC) ILAST=IC - WRITE (7,88)IFIRST,ILAST + IF(MYRANK.EQ.0)WRITE (7,88)IFIRST,ILAST DO J=JC,1,-1 READ(1,66,IOSTAT=ISO)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,166)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) + IF(MYRANK.EQ.0) + & WRITE (7,166)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDDO ELSE IFIRST=1 ILAST=IC - WRITE (7,88)IFIRST,ILAST + IF(MYRANK.EQ.0)WRITE (7,88)IFIRST,ILAST DO J=JC,1,-1 READ(1,66,IOSTAT=ISO)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) IF(ISO.GT.0) GOTO 800 - WRITE (7,166)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) + IF(MYRANK.EQ.0) + & WRITE (7,166)ADUMMY,(IJCTLT(I,J),I=IFIRST,ILAST) ENDDO - WRITE(7,15) + IF(MYRANK.EQ.0)WRITE(7,15) ENDIF ENDIF C @@ -2099,7 +2360,7 @@ C ** FILE MAPPGNS.INP TO SPECIFY A PERIODIC DOMAIN IN THE NORTH-SOUTH C ** DIRECTION C IF(ISPGNS.GE.1)THEN - PRINT *,'READING MAPPGNS.INP' + IF(MYRANK.EQ.0) PRINT *,'READING MAPPGNS.INP' OPEN(1,FILE='MAPPGNS.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2184,7 +2445,7 @@ C ** READ IN DX, DY, DEPTH AND BOTTOM ELEVATION AT CELL CENTERS OF C ** VARIABLE CELLS C IF(LVC.GT.0)THEN - PRINT *,'READING DXDY.INP' + IF(MYRANK.EQ.0) PRINT *,'READING DXDY.INP' OPEN(1,FILE='DXDY.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2374,7 +2635,7 @@ C C ** OPEN FILE MODDXDY.INP TO MODIFY INPUT VALUES OF DX AND DY C IF(IMDXDY.GT.0)THEN - PRINT *,'READING MODDXDY.INP' + IF(MYRANK.EQ.0) PRINT *,'READING MODDXDY.INP' OPEN(1,FILE='MODDXDY.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND HEADER LINES @@ -2399,7 +2660,7 @@ C ** HOST CELLS C MDCHH=0 IF(ISCHAN.GT.0)THEN - PRINT *,'READING MODCHAN.INP' + IF(MYRANK.EQ.0) PRINT *,'READING MODCHAN.INP' OPEN(1,FILE='MODCHAN.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2465,7 +2726,7 @@ C ** BY INFILTRATION AND EVAPOTRANSPIRATION C ISGWIE=0 IF(ISGWIT.EQ.1)THEN - PRINT *,'READING GWATER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING GWATER.INP' OPEN(1,FILE='GWATER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2488,7 +2749,7 @@ C C ** OPEN FILE FBODY.INP TO READ IN SPATIALLY VARYING BODY FORCES C IF(ISBODYF.GE.1)THEN - PRINT *,'READING FBODY.INP' + IF(MYRANK.EQ.0) PRINT *,'READING FBODY.INP' OPEN(1,FILE='FBODY.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2520,7 +2781,7 @@ C ** OR RECIRCULATION BOUNDARY CONDITIONS C NSBDLDBC=0 IF(ISBDLDBC.GE.1)THEN - PRINT *,'READING SEDBLBC.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SEDBLBC.INP' OPEN(1,FILE='SEDBLBC.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2564,7 +2825,7 @@ C ** AMBIENT GROUNDWATER FLOW ENDDO CLOSE(1) ENDIF - PRINT *,'READING GWMAP.INP' + IF(MYRANK.EQ.0) PRINT *,'READING GWMAP.INP' OPEN(1,FILE='GWMAP.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -2594,7 +2855,7 @@ C ** DETERMINING GRAIN STRESS C IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN IF(ISBEDSTR.EQ.3)THEN - PRINT *,'READING SEDROUGH.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SEDROUGH.INP' OPEN(1,FILE='SEDROUGH.INP') DO IS=1,2 READ(1,*) @@ -2619,7 +2880,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTDOCW.EQ.1)THEN - PRINT *,'READING DOCW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING DOCW.INP' OPEN(1,FILE='DOCW.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2648,7 +2909,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTPOCW.EQ.1)THEN - PRINT *,'READING POCW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING POCW.INP' OPEN(1,FILE='POCW.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2678,7 +2939,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTPOCW.EQ.3)THEN - PRINT *,'READING FPOCW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING FPOCW.INP' OPEN(1,FILE='FPOCW.INP',STATUS='UNKNOWN') DO NS=1,NSED+NSND DO IS=1,8 @@ -2710,7 +2971,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTDOCB.EQ.1)THEN - PRINT *,'READING DOCB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING DOCB.INP' OPEN(1,FILE='DOCB.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2787,7 +3048,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTPOCB.EQ.1)THEN - PRINT *,'READING POCB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING POCB.INP' OPEN(1,FILE='POCB.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2865,7 +3126,7 @@ C ENDDO IF(IVAL.EQ.1)THEN IF(ISTPOCB.EQ.3)THEN - PRINT *,'READING FPOCB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING FPOCB.INP' OPEN(1,FILE='FPOCB.INP',STATUS='UNKNOWN') DO NS=1,NSED+NSND DO IS=1,8 @@ -2943,7 +3204,7 @@ C ** PARTICULATE ORGANIC CARBON IN BED AND PSEUDO-POC IN BED C IF(ISTPOCB.EQ.4)THEN C - PRINT *,'READING FOCB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING FOCB.INP' OPEN(1,FILE='FOCB.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2966,7 +3227,7 @@ C ENDDO CLOSE(1) C - PRINT *,'READING PSEUDO_FOCB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING PSEUDO_FOCB.INP' OPEN(1,FILE='PSEUDO_FOCB.INP',STATUS='UNKNOWN') DO IS=1,8 READ(1,*) @@ -2999,7 +3260,7 @@ C & (ISRESTI.GE.1.AND.ISCI(1).EQ.0).OR. & (ISTOPT(1).GT.1)))THEN ! *** PMC SINGLE LINE - FORCE IC IF(ISTOPT(1).GE.1)THEN - PRINT *,'READING SALT.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SALT.INP' OPEN(1,FILE='SALT.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3035,7 +3296,7 @@ C & (ISRESTI.GE.1.AND.ISCI(2).EQ.0).OR. & (ISTOPT(2).GT.9)))THEN ! *** PMC SINGLE LINE - FORCE IC IF(ISTOPT(2).GE.1.OR.INITTEMP.GT.0)THEN - PRINT *,'READING TEMP.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TEMP.INP' OPEN(1,FILE='TEMP.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3070,7 +3331,7 @@ C & (ISRESTI.GE.1.AND.ISCI(3).EQ.0).OR. & (ISTOPT(3).GT.1)))THEN ! *** PMC SINGLE LINE - FORCE IC IF(ISTOPT(3).GE.1)THEN - PRINT *,'READING DYE.INP' + IF(MYRANK.EQ.0) PRINT *,'READING DYE.INP' OPEN(1,FILE='DYE.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3103,7 +3364,7 @@ C ENDDO IF(ISRESTI.EQ.0.AND.ISTRAN(4).GE.1)THEN IF(ISTOPT(4).GE.1)THEN - PRINT *,'READING SFL.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SFL.INP' OPEN(1,FILE='SFL.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3165,7 +3426,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(5).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(5).GE.1)THEN IF(ISLTMT.EQ.0)THEN - PRINT *,'READING TOXW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TOXW.INP' OPEN(1,FILE='TOXW.INP',STATUS='UNKNOWN') IF(ITXINT(1).EQ.1.OR.ITXINT(1).EQ.3)THEN DO NT=1,NTOX @@ -3198,7 +3459,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(5).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(5).GE.1)THEN IF(ISLTMT.EQ.0.)THEN - PRINT *,'READING TOXB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TOXB.INP' OPEN(1,FILE='TOXB.INP',STATUS='UNKNOWN') IF(ITXINT(1).EQ.2.OR.ITXINT(1).EQ.3)THEN DO NT=1,NTOX @@ -3269,7 +3530,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(6).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(6).GE.1)THEN IF(ITXINTT.GE.1)THEN - PRINT *,'READING SEDW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SEDW.INP' OPEN(1,FILE='SEDW.INP',STATUS='UNKNOWN') DO NS=1,NSED C @@ -3303,7 +3564,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(6).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(6).GE.1.AND.IWRSP(1)/=98)THEN !avoids loop if SEDZLJ is active IF(ITXINTT.GE.1)THEN - PRINT *,'READING SEDB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SEDB.INP' OPEN(1,FILE='SEDB.INP',STATUS='UNKNOWN') DO NS=1,NSED C @@ -3379,7 +3640,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(7).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(7).GE.1)THEN IF(ITXINTT.GE.1)THEN - PRINT *,'READING SNDW.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SNDW.INP' OPEN(1,FILE='SNDW.INP',STATUS='UNKNOWN') DO NX=1,NSND C @@ -3413,7 +3674,7 @@ C IF(ISRESTI.GE.1.AND.ISCI(7).EQ.0) IISTMP=0 IF(IISTMP.EQ.0.AND.ISTRAN(7).GE.1)THEN IF(ITXINTT.GE.1)THEN - PRINT *,'READING SNDB.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SNDB.INP' OPEN(1,FILE='SNDB.INP',STATUS='UNKNOWN') DO NX=1,NSND C @@ -3457,7 +3718,7 @@ C C ** BED LAYER THICKNESS C IF(IISTMP.EQ.0.AND.IBMECH.GE.1)THEN - PRINT *,'READING BEDLAY.INP' + IF(MYRANK.EQ.0) PRINT *,'READING BEDLAY.INP' OPEN(1,FILE='BEDLAY.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3491,7 +3752,7 @@ C C ** BED LAYER BULK DENSITY C IF(IISTMP.EQ.0.AND.IBMECH.GE.1)THEN - PRINT *,'READING BEDBDN.INP' + IF(MYRANK.EQ.0) PRINT *,'READING BEDBDN.INP' OPEN(1,FILE='BEDBDN.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3525,7 +3786,7 @@ C C ** BED LAYER DRY DENSITY, POROSITY OR VOID RATIO C IF(IISTMP.EQ.0.AND.IBMECH.GE.1)THEN - PRINT *,'READING BEDDDN.INP' + IF(MYRANK.EQ.0) PRINT *,'READING BEDDDN.INP' OPEN(1,FILE='BEDDDN.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3559,7 +3820,7 @@ C C ** CONSOLIDATION MAP C IF(IBMECH.EQ.9)THEN - PRINT *,'READING CONSOLMAP.INP' + IF(MYRANK.EQ.0) PRINT *,'READING CONSOLMAP.INP' OPEN(1,FILE='CONSOLMAP.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3589,7 +3850,7 @@ C ** READ IN OPEN BOUNDARY SURFACE ELEVATION TIME SERIES FROM THE C ** FILE PSER.INP C IF(NPSER.GE.1)THEN - PRINT *,'READING PSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING PSER.INP' OPEN(1,FILE='PSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3616,7 +3877,7 @@ C ** READ IN VOLUMETRIC SOURCE OR RIVER INFLOW TIME SERIES FROM THE C ** FILE QSER.INP C IF(NQSER.GE.1)THEN - PRINT *,'READING QSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING QSER.INP' OPEN(1,FILE='QSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3663,7 +3924,7 @@ C ** READ IN FLOW WITHDRAWL-RETURN FLOW AND CONCENTRATION RISE C ** TIME SERIES FROM THE FILE QWRS.INP C IF(NQWRSR.GE.1)THEN - PRINT *,'READING QWRS.INP' + IF(MYRANK.EQ.0) PRINT *,'READING QWRS.INP' OPEN(1,FILE='QWRS.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3707,7 +3968,7 @@ C ** READ IN GROUNDWATER INFLOW/OUTFLOW AND CONCENTRATION TIME C ** SERIES FROM THE FILE GWSER.INP C IF(ISGWIT.EQ.2)THEN - PRINT *,'READING GWSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING GWSER.INP' OPEN(1,FILE='GWSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3747,7 +4008,7 @@ C ** FROM THE FILE SSER.INP C 8888 FORMAT(3I5,2F10.2) IF(NCSER(1).GE.1)THEN - PRINT *,'READING SSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SSER.INP' OPEN(1,FILE='SSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3765,9 +4026,11 @@ C IF(ISO.GT.0) GOTO 870 DO M=1,MCSER(NS,NC) READ(1,*,IOSTAT=ISO)TCSER(M,NS,NC),CSERTMP + IF(MYRANK.EQ.0)THEN IF(M.EQ.1)WRITE(8,8888)NC,NS,M,TCSER(M,NS,NC),CSERTMP IF(M.EQ.MCSER(NS,NC))WRITE(8,8888)NC,NS,M, & TCSER(M,NS,NC),CSERTMP + ENDIF IF(ISO.GT.0) GOTO 870 TCSER(M,NS,NC)=TCSER(M,NS,NC)+TACSER(NS,NC) DO K=1,KC @@ -3792,7 +4055,7 @@ C ** READ IN OPEN BOUNDARY OR VOLUMETRIC SOURCE TEMPERATURE TIME C ** SERIES FROM THE FILE TSER.INP C IF(NCSER(2).GE.1)THEN - PRINT *,'READING TSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TSER.INP' OPEN(1,FILE='TSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3810,9 +4073,11 @@ C IF(ISO.GT.0) GOTO 880 DO M=1,MCSER(NS,NC) READ(1,*,IOSTAT=ISO)TCSER(M,NS,NC),CSERTMP + IF(MYRANK.EQ.0)THEN IF(M.EQ.1)WRITE(8,8888)NC,NS,M,TCSER(M,NS,NC),CSERTMP IF(M.EQ.MCSER(NS,NC))WRITE(8,8888)NC,NS,M, & TCSER(M,NS,NC),CSERTMP + ENDIF IF(ISO.GT.0) GOTO 880 TCSER(M,NS,NC)=TCSER(M,NS,NC)+TACSER(NS,NC) DO K=1,KC @@ -3837,7 +4102,7 @@ C ** READ IN OPEN BOUNDARY OR VOLUMETRIC SOURCE DYE CONCENTRATION C ** TIME SERIES FROM THE FILE DSER.INP C IF(NCSER(3).GE.1)THEN - PRINT *,'READING DSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING DSER.INP' OPEN(1,FILE='DSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3881,7 +4146,7 @@ C IF(NSED.GT.0)THEN NFSED=MSVSED(1) IF(NCSER(NFSED).GE.1)THEN - PRINT *,'READING SDSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SDSER.INP' OPEN(1,FILE='SDSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -3958,7 +4223,7 @@ C IF(NSND.GT.0)THEN NFSND=MSVSND(1) IF(NCSER(NFSND).GE.1)THEN - PRINT *,'READING SNSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SNSER.INP' OPEN(1,FILE='SNSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4040,7 +4305,7 @@ C2001 FORMAT(3I5,2F12.5) ENDDO IF (ISTRAN(5).GE.1 .and. IDTOX.GT.0) THEN - PRINT *,'READING TOXINFO.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TOXINFO.INP' CALL READTOX ENDIF ! GeoSR} @@ -4052,7 +4317,7 @@ C IF(NTOX.GT.0)THEN NFTOX=MSVTOX(1) IF(NCSER(NFTOX).GE.1)THEN - PRINT *,'READING TXSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING TXSER.INP' OPEN(1,FILE='TXSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4121,7 +4386,7 @@ C ** READ IN OPEN BOUNDARY OR VOLUMETRIC SOURCE SHELL FISH LARVAE C ** TIME SERIES FROM THE FILE SFSER.INP C IF(NCSER(4).GE.1)THEN - PRINT *,'READING SFSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SFSER.INP' OPEN(1,FILE='SFSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4169,9 +4434,9 @@ C ELSE C ENTER QCTL(M,K,NS) VS HDIFCTL(M,NS) TABLE WITH DELH TO GIVE C IF(NQCTL.GE.1 .AND. NQCTYP1.LT.3)THEN ! GEOSR JGCHO 2011.10.28 .AND. NQCTYP1.LT.3)THEN - PRINT *,'READING QCTL.INP' + IF(MYRANK.EQ.0) PRINT *,'READING QCTL.INP' OPEN(1,FILE='QCTL.INP',STATUS='UNKNOWN') - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(99,FILE='QCTLCK.INP',STATUS='UNKNOWN') CLOSE(99,STATUS='DELETE') OPEN(99,FILE='QCTLCK.INP',STATUS='UNKNOWN') @@ -4185,7 +4450,7 @@ C DO NS=1,NQCTLT READ(1,*, IOSTAT=ISO)ISTYP,MQCTL(NS),HCTLUA(NS),HCTLUM(NS), & HCTLDA(NS),HCTLDM(NS),RMULADJ,ADDADJ,AQCTL(NS) - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN WRITE(99,991)NS WRITE(99,992)ISTYP,MQCTL(NS),HCTLUA(NS),HCTLUM(NS), & HCTLDA(NS),HCTLDM(NS),RMULADJ,ADDADJ,AQCTL(NS) @@ -4236,7 +4501,7 @@ C ENDDO ENDDO ENDIF - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN IF(ISTYP.LE.1)THEN DO M=1,MQCTL(NS) WRITE(99,993)M,HDIFCTL(M,NS),(QCTL(M,1,K,NS),K=1,KC) @@ -4259,12 +4524,12 @@ C C { EDITED BY GEOSR 2010.5.7 C ** READ GATE CONTROL FILE : GATECTL.INP IF (NQCTL.GE.1 .AND. NQCTYP1.GE.3) THEN - PRINT *,'READING GATECTL.INP' + IF(MYRANK.EQ.0) PRINT *,'READING GATECTL.INP' CALL GATECTLREAD !!!!!!!!!!!!!!!!!!!!!!!!!! { READ GATESER.INP JGCHO 2011.10.27 - PRINT *,'READING GATESER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING GATESER.INP' OPEN(1,FILE='GATESER.INP',STATUS='UNKNOWN') - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(99,FILE='GATESERK.OUT',STATUS='UNKNOWN') CLOSE(99,STATUS='DELETE') OPEN(99,FILE='GATESERK.OUT',STATUS='UNKNOWN') @@ -4275,7 +4540,7 @@ C ** SKIP OVER TITLE AND AND HEADER LINES ENDDO DO NS=1,NQCTLT READ(1,*, IOSTAT=ISO)ISTYP,MQCTL(NS),GCCSER(NS) - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN WRITE(99,991)NS WRITE(99,992)ISTYP,MQCTL(NS),GCCSER(NS) ENDIF @@ -4289,7 +4554,7 @@ C ** SKIP OVER TITLE AND AND HEADER LINES IF(ISO.GT.0) GOTO 920 ENDDO ! ENDIF - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN IF(ISTYP.LE.1)THEN DO M=1,MQCTL(NS) WRITE(99,995)M,GCSER(M,NS),IAG(M,NS),NGATE(M,NS) @@ -4349,7 +4614,7 @@ C CCNHTT(L)=0. ENDDO IF(NASER.GT.0)THEN - PRINT *,'READING ASER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING ASER.INP' OPEN(1,FILE='ASER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4370,10 +4635,10 @@ C READ(1,22)TEXT USESHADE=PARSE_LOGICAL(TEXT) - PRINT *,' NUMBER OF ATMOSPHERE SERIES=',NASER - PRINT *,' COMPUTESOLRAD=',COMPUTESOLRAD - PRINT *,' DS_LONG=',DS_LONG - PRINT *,' DS_LAT=',DS_LAT + IF(MYRANK.EQ.0) PRINT *,' NUMBER OF ATMOSPHERE SERIES=',NASER + IF(MYRANK.EQ.0) PRINT *,' COMPUTESOLRAD=',COMPUTESOLRAD + IF(MYRANK.EQ.0) PRINT *,' DS_LONG=',DS_LONG + IF(MYRANK.EQ.0) PRINT *,' DS_LAT=',DS_LAT DO IS=1,3 READ(1,*) @@ -4420,7 +4685,7 @@ C ENDDO ENDIF IF(NASER.GT.1)THEN - PRINT *,'READING ATMMAP.INP' + IF(MYRANK.EQ.0) PRINT *,'READING ATMMAP.INP' OPEN(1,FILE='ATMMAP.INP',STATUS='UNKNOWN') DO IS=1,4 READ(1,*) @@ -4450,7 +4715,7 @@ C TSY(L)=0. ENDDO IF(NWSER.GT.0)THEN - PRINT *,'READING WSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING WSER.INP' OPEN(1,FILE='WSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4473,11 +4738,11 @@ C WINTER_END=0. ENDIF - PRINT *,' NUMBER OF WIND SERIES=',NWSER - PRINT *,' ANEMOMETER HEIGHT (m)=',WINDH + IF(MYRANK.EQ.0) PRINT *,' NUMBER OF WIND SERIES=',NWSER + IF(MYRANK.EQ.0) PRINT *,' ANEMOMETER HEIGHT (m)=',WINDH IF (WINTER_START.LT.WINTER_END) THEN - PRINT *,' SURFACE WIND STRESSES TURNED OFF FROM ',WINTER_START - & ," TO ",WINTER_END + IF(MYRANK.EQ.0) PRINT *,' SURFACE WIND STRESSES TURNED OF + & F FROM ',WINTER_START," TO ",WINTER_END ENDIF DO IS=1,2 @@ -4526,7 +4791,7 @@ C ENDDO ENDIF IF(NWSER.GT.1)THEN - PRINT *,'READING WNDMAP.INP' + IF(MYRANK.EQ.0) PRINT *,'READING WNDMAP.INP' OPEN(1,FILE='WNDMAP.INP',STATUS='UNKNOWN') DO IS=1,4 READ(1,*) @@ -4544,7 +4809,7 @@ C ** READ IN SHELL FISH LARAVE BEHAVIOR DATA C ** FROM THE FILE SFBSER.INP C IF(ISTRAN(4).GE.1)THEN - PRINT *,'READING SFBSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING SFBSER.INP' OPEN(1,FILE='SFBSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4566,7 +4831,7 @@ C C ** READ VEGETATION DATA FROM VEGE.INP AND VEGSER.INP C IF(ISVEG.GE.1)THEN - PRINT *,'READING VEGE.INP' + IF(MYRANK.EQ.0) PRINT *,'READING VEGE.INP' OPEN(1,FILE='VEGE.INP',STATUS='UNKNOWN') DO NS=1,12 READ(1,*) @@ -4594,7 +4859,7 @@ C STOP 3122 CONTINUE IF(NVEGSER.GE.1)THEN - PRINT *,'READING VEGSER.INP' + IF(MYRANK.EQ.0) PRINT *,'READING VEGSER.INP' OPEN(1,FILE='VEGSER.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -4670,115 +4935,115 @@ C C ** WRITE READ ERROR FOR OTHER INPUT FILES AND TERMINATE RUN C 800 WRITE(6,801) - WRITE(8,801) + IF(MYRANK.EQ.0) WRITE(8,801) 801 FORMAT(' READ ERROR FOR FILE CELL.INP ') STOP C 820 WRITE(6,821) - WRITE(8,821) + IF(MYRANK.EQ.0) WRITE(8,821) 821 FORMAT(' READ ERROR FOR FILE DEPTH.INP ') STOP 830 WRITE(6,831) - WRITE(8,831) + IF(MYRANK.EQ.0) WRITE(8,831) 831 FORMAT(' READ ERROR FOR FILE DXDY.INP ') STOP 840 WRITE(6,841) - WRITE(8,841) + IF(MYRANK.EQ.0) WRITE(8,841) 841 FORMAT(' READ ERROR FOR FILE SALT.INP ') STOP 842 WRITE(6,843) - WRITE(8,843) + IF(MYRANK.EQ.0) WRITE(8,843) 843 FORMAT(' READ ERROR FOR FILE TEMP.INP ') STOP 844 WRITE(6,845) - WRITE(8,845) + IF(MYRANK.EQ.0) WRITE(8,845) 845 FORMAT(' READ ERROR FOR FILE DYE.INP ') STOP 846 WRITE(6,847) - WRITE(8,847) + IF(MYRANK.EQ.0) WRITE(8,847) 847 FORMAT(' READ ERROR FOR FILE SFL.INP ') STOP 848 WRITE(6,849) - WRITE(8,849) + IF(MYRANK.EQ.0) WRITE(8,849) 849 FORMAT(' READ ERROR FOR FILE TOXW.INP ') STOP 852 WRITE(6,853) - WRITE(8,853) + IF(MYRANK.EQ.0) WRITE(8,853) 853 FORMAT(' READ ERROR FOR FILE TOXB.INP ') STOP 850 WRITE(6,851) - WRITE(8,851) + IF(MYRANK.EQ.0) WRITE(8,851) 851 FORMAT(' READ ERROR FOR FILE PSER.INP ') STOP 854 WRITE(6,855) - WRITE(8,855) + IF(MYRANK.EQ.0) WRITE(8,855) 855 FORMAT(' READ ERROR FOR FILE SEDW.INP ') STOP 856 WRITE(6,857) - WRITE(8,857) + IF(MYRANK.EQ.0) WRITE(8,857) 857 FORMAT(' READ ERROR FOR FILE SEDB.INP ') STOP 858 WRITE(6,859) - WRITE(8,859) + IF(MYRANK.EQ.0) WRITE(8,859) 859 FORMAT(' READ ERROR FOR FILE SNDW.INP ') STOP 862 WRITE(6,863) - WRITE(8,863) + IF(MYRANK.EQ.0) WRITE(8,863) 863 FORMAT(' READ ERROR FOR FILE SNDB.INP ') STOP 860 WRITE(6,861) - WRITE(8,861) + IF(MYRANK.EQ.0) WRITE(8,861) 861 FORMAT(' READ ERROR FOR FILE QSER.INP ') STOP 865 WRITE(6,866) - WRITE(8,866) + IF(MYRANK.EQ.0) WRITE(8,866) 866 FORMAT(' READ ERROR FOR FILE QWRS.INP ') STOP 870 WRITE(6,871) - WRITE(8,871) + IF(MYRANK.EQ.0) WRITE(8,871) 871 FORMAT(' READ ERROR FOR FILE SSER.INP ') STOP 880 WRITE(6,881) - WRITE(8,881) + IF(MYRANK.EQ.0) WRITE(8,881) 881 FORMAT(' READ ERROR FOR FILE TSER.INP ') STOP 890 WRITE(6,891) - WRITE(8,891) + IF(MYRANK.EQ.0) WRITE(8,891) 891 FORMAT(' READ ERROR FOR FILE DSER.INP ') STOP 900 WRITE(6,901) - WRITE(8,901) + IF(MYRANK.EQ.0) WRITE(8,901) 901 FORMAT(' READ ERROR FOR FILE SDSER.INP ') STOP 902 WRITE(6,903) - WRITE(8,903) + IF(MYRANK.EQ.0) WRITE(8,903) 903 FORMAT(' READ ERROR FOR FILE SNSER.INP ') STOP 904 WRITE(6,905) - WRITE(8,905) + IF(MYRANK.EQ.0) WRITE(8,905) 905 FORMAT(' READ ERROR FOR FILE TXSER.INP ') STOP 910 WRITE(6,911) - WRITE(8,911) + IF(MYRANK.EQ.0) WRITE(8,911) 911 FORMAT(' READ ERROR FOR FILE SFSER.INP ') STOP 920 WRITE(6,921) - WRITE(8,921) + IF(MYRANK.EQ.0) WRITE(8,921) 921 FORMAT('READ ERROR FOR FILE QCTL.INP OR GATESER.INP') STOP 940 WRITE(6,941) - WRITE(8,941) + IF(MYRANK.EQ.0) WRITE(8,941) 941 FORMAT(' READ ERROR FOR FILE ASER.INP ') STOP 950 WRITE(6,951) - WRITE(8,951) + IF(MYRANK.EQ.0) WRITE(8,951) 951 FORMAT(' READ ERROR FOR FILE MAPPGNS.INP ') STOP 960 WRITE(6,961) - WRITE(8,961) + IF(MYRANK.EQ.0) WRITE(8,961) 961 FORMAT(' READ ERROR FOR FILE SFBSER.INP ') STOP C 970 WRITE(6,971) - WRITE(8,971) + IF(MYRANK.EQ.0) WRITE(8,971) 971 FORMAT(' READ ERROR FOR FILE TIDASM.INP ') STOP 3000 CONTINUE @@ -4787,6 +5052,7 @@ C 970 WRITE(6,971) ! *** DSLLC UTIL FUNCTION PARSE_REAL(INLINE) + USE MPI, ONLY: MYRANK CHARACTER*(*) INLINE CHARACTER*15 CVAL @@ -4811,7 +5077,8 @@ C 970 WRITE(6,971) ENDIF ENDDO - 999 print *, ' error parsing real' + 999 CONTINUE + IF(MYRANK.EQ.0) print *, ' error parsing real' RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for index 407ac9123..02061f645 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/JPEFDC.for @@ -9,6 +9,7 @@ C ** FOR MORE INFO EMAIL HAM@VISI.NET C CHANGE RECORD C USE GLOBAL + USE MPI PARAMETER (NJELM=2,NATDM=1) CHARACTER*11 FNJPGEO,FNJPVEL,FNJPCON,FNJPTOX,FNJPTPF,FNJPLOG, & FNNRFLD,FNNRFLB @@ -268,9 +269,11 @@ C FNNUM(23)= '23' FNNUM(24)= '24' FNNUM(25)= '25' + IF(MYRANK.EQ.0)THEN OPEN(88,FILE='JPBUG.DIA',POSITION='APPEND') CLOSE(88,STATUS='DELETE') ENDIF + ENDIF C C ** LOOP OVER ALL JET/PLUME LOCATIONS C @@ -281,7 +284,7 @@ C VJPAVG(K,NJP)=0.0 WJPAVG(K,NJP)=0.0 ENDDO - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN FNJPLOG='JPLOG' // FNNUM(NJP) // '.OUT' IF(N.EQ.1) OPEN(10,FILE=FNJPLOG,STATUS='UNKNOWN') IF(N.EQ.1) CLOSE(10,STATUS='DELETE') @@ -492,7 +495,7 @@ C & +U(L,K)*(BELV(L)-BELV(L-1))*DXIU(L) & +V(LN,K)*(BELV(LN)-BELV(L))*DYIV(LN) & +V(L,K)*(BELV(L)-BELV(LS))*DYIV(L)) - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(88,FILE='JPBUG.DIA',POSITION='APPEND') WRITE(88,889)NZ,K,L,LN,LS,SALAD(NZ,1),TEMAD(NZ,1), & TOXAD(NZ,1,1) @@ -524,7 +527,7 @@ C C C ** OPEN OUTPUT FILES C - IF(LOUTJET)THEN + IF(LOUTJET.AND.MYRANK.EQ.0)THEN FNJPGEO='JPGEO' // FNNUM(NJP) // '.OUT' FNJPVEL='JPVEL' // FNNUM(NJP) // '.OUT' FNJPCON='JPCON' // FNNUM(NJP) // '.OUT' @@ -568,7 +571,7 @@ C ENDIF ENDIF - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN IF(N.EQ.1) THEN OPEN(11,FILE='JPMOMENT.OUT') CLOSE(11,STATUS='DELETE') @@ -1222,11 +1225,13 @@ C IF(NI.GT.NIMAX)THEN KFLAG=1 + IF(MYRANK.EQ.0)THEN IF(DEBUG)WRITE(10,620)NJP,NJE,NI,ITMP,DRMAJSA,DRMAJSO, & DRMAJFA,DRMAJFO WRITE(6,601)NJE,NI IF(DEBUG)WRITE(10,601)NJE,NI WRITE(8,601)NJE,NI + ENDIF GOTO 2000 ENDIF C @@ -1235,10 +1240,12 @@ C IF(ISTOP.EQ.1)THEN ZJGTOP=ZJG(NE) IF(ZJGTOP.GT.ZSUR)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6050)NJP,NJE,NI,ZJGTOP,ZSUR IF(DEBUG)WRITE(10,605)NJP,NJE,NI,ZJGTOP,ZSUR IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,605)NJP,NJE,NI,ZJGTOP,ZSUR + ENDIF GOTO 2000 ENDIF ENDIF @@ -1248,10 +1255,12 @@ C IF(ISTOP.EQ.1)THEN ZJGBOT=ZJG(NE) IF(ZJGBOT.LT.ZBOT)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6060)NJP,NJE,NI,ZJGBOT,ZBOT IF(DEBUG)WRITE(10,606)NJP,NJE,NI,ZJGBOT,ZBOT IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,606)NJP,NJE,NI,ZJGBOT,ZBOT + ENDIF GOTO 2000 ENDIF ENDIF @@ -1261,10 +1270,12 @@ C IF(ISTOP.EQ.2)THEN ZJGTOP=ZJG(NE)+RADJ(NE)*COS(0.0175*PHJ(NE)) IF(ZJGTOP.GT.ZSUR)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6020)NJP,NJE,NI,ZJGTOP,ZSUR IF(DEBUG)WRITE(10,602)NJP,NJE,NI,ZJGTOP,ZSUR IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,602)NJP,NJE,NI,ZJGTOP,ZSUR + ENDIF GOTO 2000 ENDIF ENDIF @@ -1274,10 +1285,12 @@ C IF(ISTOP.EQ.2)THEN ZJGBOT=ZJG(NE)-RADJ(NE)*COS(0.0175*PHJ(NE)) IF(ZJGBOT.LT.ZBOT)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6030)NJP,NJE,NI,ZJGBOT,ZBOT IF(DEBUG)WRITE(10,603)NJP,NJE,NI,ZJGBOT,ZBOT IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,603)NJP,NJE,NI,ZJGBOT,ZBOT + ENDIF GOTO 2000 ENDIF ENDIF @@ -1289,10 +1302,12 @@ C IF(RHOJ(NE).GE.RHOJ(NM))THEN DRHOT=(RHOA-RHOJ(NE))/RHOA IF(DRHOT.LT.0.)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6040)NJP,NJE,NI,ZJG(NE) IF(DEBUG)WRITE(10,604)NJP,NJE,NI,ZJG(NE) IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,604)NJP,NJE,NI,ZJG(NE) + ENDIF GOTO 2000 ENDIF ENDIF @@ -1302,10 +1317,12 @@ C IF(RHOJ(NE).LT.RHOJ(NM))THEN DRHOT=(RHOA-RHOJ(NE))/RHOA IF(DRHOT.GT.0.)THEN + IF(MYRANK.EQ.0)THEN WRITE(6,6040)NJP,NJE,NI,ZJG(NE) IF(DEBUG)WRITE(10,604)NJP,NJE,NI,ZJG(NE) IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) WRITE(8,604)NJP,NJE,NI,ZJG(NE) + ENDIF GOTO 2000 ENDIF ENDIF @@ -1489,7 +1506,7 @@ C DO K=1,KC QJPENTT(NJP)=QJPENTT(NJP)+QJPENT(K,NJP) ENDDO - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN WRITE(8,898)NJP,TIME,(QJPENT(K,NJP),K=1,KC),QJPENTT(NJP) WRITE(10,898)NJP,TIME,(QJPENT(K,NJP),K=1,KC),QJPENTT(NJP) ENDIF @@ -1589,7 +1606,8 @@ C C C ** WRITE OUT SAVED RESULTS IN COMPACT ASCII FORMAT C - IF(LOUTJET.AND.(IOUTJP(NJP).EQ.2.OR.IOUTJP(NJP).EQ.3))THEN + IF(LOUTJET.AND.(IOUTJP(NJP).EQ.2.OR.IOUTJP(NJP).EQ.3) + & .AND.MYRANK.EQ.0)THEN IF(N.EQ.1) OPEN(1,FILE=FNNRFLD,STATUS='UNKNOWN') IF(N.EQ.1) CLOSE(1,STATUS='DELETE') OPEN(1,FILE=FNNRFLD,STATUS='UNKNOWN',POSITION='APPEND') @@ -1632,7 +1650,7 @@ C C C ** WRITE OUT SAVED RESULTS IN BINARY FORMAT C - IF(IOUTJP(NJP).EQ.4)THEN + IF(IOUTJP(NJP).EQ.4.AND.MYRANK.EQ.0)THEN IF(N.EQ.1) OPEN(1,FILE=FNNRFLB,FORM='UNFORMATTED') IF(N.EQ.1) CLOSE(1,STATUS='DELETE') OPEN(1,FILE=FNNRFLB,POSITION='APPEND',FORM='UNFORMATTED') @@ -1681,7 +1699,8 @@ C 9000 CONTINUE KEFFJP(NJP)=KQJP(NJP) 9001 CONTINUE - WRITE(8 ,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) + IF(MYRANK.EQ.0) WRITE(8 ,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) + IF(MYRANK.EQ.0)THEN IF(DEBUG)WRITE(10,899)NJP,TIME,(QJPENT(K,NJP),K=1,KC) IF(DEBUG)THEN WRITE(10,135)NJP,TIME,KFLAG,KEFFJP(NJP),KQJP(NJP), @@ -1696,6 +1715,7 @@ C & QJTOT C ENDIF CLOSE(10) ENDIF + ENDIF C C ** CALCULATION MOMENT INTERFACE QUANTITIES C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LSQHARM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LSQHARM.for index 6e87d2c53..31ac5ac03 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LSQHARM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/LSQHARM.for @@ -4,6 +4,7 @@ C CHANGE RECORD C ** SUBROUTINE LSQHARM PERFORMS A LEAST SQUARES HARMONIC ANALYSIS C USE GLOBAL + USE MPI CHARACTER*80 TITLE,TITNT,TITRT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::AMATMP @@ -179,9 +180,11 @@ C C *** COMPLETE ANALYSIS C 200 CONTINUE + IF(MYRANK.EQ.0)THEN OPEN(97,FILE='LSHA.OUT',STATUS='UNKNOWN') CLOSE(97,STATUS='DELETE') OPEN(97,FILE='LSHA.OUT',STATUS='UNKNOWN') + ENDIF IF(ISLSTR.EQ.1) GOTO 500 C C *** COMPUTE SOLUTION WITH NO TREND REMOVAL @@ -209,12 +212,14 @@ C C *** PERFORM SVD ON GLSHA C CALL SVDCMP (GLSHA,MG,MG,MGM,MGM,WLSHA,VVLSHA) + IF(MYRANK.EQ.0)THEN WRITE(97,10)TITNT WRITE(97,11) DO M=1,MG WRITE(97,12)WLSHA(M) ENDDO WRITE(97,13) + ENDIF C C *** SOLVE BY BACK SUBSTITUTION AND OUTPUT RESULTS C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile index f98c135fb..e08f4eed9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/Makefile @@ -100,7 +100,7 @@ openmp: MAKE_FFLAGS += $(F_OPENMP) openmp: MAKE_SO += $(F_OPENMP) openmp: libEfdcOrig.a -libEfdcOrig.a: $(OBJECTS) $(COMPAT_OBJS) +libEfdcOrig.a: global.mod mpi.mod $(OBJECTS) $(COMPAT_OBJS) rm -f $@ ar cq $@ $(OBJECTS) $(COMPAT_OBJS) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for index 5a2defa4f..51c8a4425 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/NEGDEP.for @@ -5,12 +5,14 @@ C ADDED ALTERNATE SOR EQUATION SOLVER RELAX2T C ** SUBROUTINE NEGDEP CHECK EXTERNAL SOLUTION FOR NEGATIVE DEPTHS C USE GLOBAL + USE MPI DIMENSION QCHANUT(NCHANM),QCHANVT(NCHANM) INTEGER INEGFLG INEGFLG=0 C C ** CHECK FOR NEGATIVE DEPTHS C + IF(MYRANK.EQ.0)THEN IF(ISNEGH.GE.1)THEN INEGFLG=0 DO L=2,LA @@ -152,6 +154,7 @@ C STOP ENDIF ENDIF + ENDIF 1001 FORMAT(2I5,10(1X,E12.4)) C1002 FORMAT(3I4,10(1X,E9.2)) 1991 FORMAT(2I5,12F8.3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for index ba808e900..2af61fc3e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUT3D.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER *11 SALFN,TEMFN,DYEFN,SEDFN,UUUFN,VVVFN,WWWFN, & CMPFN,SNDFN,TOXFN @@ -16,6 +17,7 @@ C C C ** INITIALIZE OUTPUT FILES C + IF(MYRANK.EQ.0)THEN IAD=I3DMAX-I3DMIN+1 JAD=J3DMAX-J3DMIN+1 NCALL3D=NCALL3D+1 @@ -1371,6 +1373,7 @@ C 510 FORMAT(2I5,4(2X,F10.5)) 551 FORMAT(72F7.1) 559 FORMAT(2I4,2X,72I2) CLOSE(50) + ENDIF RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTOIL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTOIL.for index c969db886..f3cd43677 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTOIL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTOIL.for @@ -3,6 +3,7 @@ SUBROUTINE OUTOIL USE GLOBAL + USE MPI IMPLICIT NONE @@ -11,6 +12,7 @@ ! REAL OILCONC + IF(MYRANK.EQ.0)THEN IF(JSPD==1) THEN OPEN(7773,FILE='MASS-TOTAL.DAT',STATUS='UNKNOWN') @@ -123,6 +125,7 @@ C & OILAREA, OILTHICK, SQRT(OILAREA/PI),SQRT(BETA1/PI*SQRT(N*DT)) ENDDO ENDIF + ENDIF END SUBROUTINE -!} \ No newline at end of file +!} diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for index 4939af430..4570ccc70 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/OUTPUT2.for @@ -3,9 +3,11 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI C C ** OUTPUT RESULTS OF RELAXATION SOLUTION C + IF(MYRANK.EQ.0)THEN WRITE (7,40) RP 40 FORMAT (1H1,' RESULTS OF RELAX SOLUTION - RP=',F5.2,//) WRITE (7,41) @@ -20,6 +22,7 @@ C 20 FORMAT (1X,I5,3X,10E12.4) 44 FORMAT('ITRMAX =',I5,5X,'ITRMIN =',I5) C 21 FORMAT (1X,I5,5X,10I10) C 30 FORMAT (10E12.4) + ENDIF C C ** OUTPUT HARMONIC ANALYSIS C @@ -34,13 +37,13 @@ C DO L=2,LA PAM(L)=PAM(L)*GI ENDDO - WRITE (7,55) + IF(MYRANK.EQ.0) WRITE (7,55) CALL PPLOT (1) 55 FORMAT (1H1,'TIDAL SURFACE DISPLACEMENT AMPLITUDE IN METERS',//) DO L=2,LA PAM(L)=0.5*TIDALP*PPH(L)/PI ENDDO - WRITE(7,588) + IF(MYRANK.EQ.0) WRITE(7,588) CALL PPLOT (1) 588 FORMAT (1H1,'TIDAL SURFACE DISPLACEMENT PHASE IN SEC',//) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for index 5eb811c00..64029fc81 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/PPLOT.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER BLANK,ASTER,LET1(51),LET2(51) DIMENSION BNDU(51),BNDL(51) CHARACTER*1,ALLOCATABLE,DIMENSION(:,:)::CHARY @@ -39,16 +40,16 @@ C ENDDO IF(IPT.EQ.1)THEN DO M=1,NBAN - WRITE (7,10) BNDU(M),LET1(M),BNDL(M) + IF(MYRANK.EQ.0) WRITE (7,10) BNDU(M),LET1(M),BNDL(M) ENDDO ELSE DO M=1,NBAN - WRITE (7,10) BNDU(M),LET2(M),BNDL(M) + IF(MYRANK.EQ.0) WRITE (7,10) BNDU(M),LET2(M),BNDL(M) ENDDO ENDIF 10 FORMAT (5X,E12.4,5X,A1,5X,E12.4) C 11 FORMAT (////) - WRITE(7,12) + IF(MYRANK.EQ.0) WRITE(7,12) 12 FORMAT(1H1) C C ** LOAD CHARACTER ARRAY @@ -78,9 +79,9 @@ C JS=JJ JE=JJ+119 IF(JE.GT.JC) JE=JC - WRITE(7,22)JS,JE + IF(MYRANK.EQ.0) WRITE(7,22)JS,JE DO I=1,IC - WRITE (7,20) I,(CHARY(I,J),J=JS,JE) + IF(MYRANK.EQ.0) WRITE (7,20) I,(CHARY(I,J),J=JS,JE) ENDDO ENDDO 20 FORMAT (1X,I3,2X,120A1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for index 22de6780b..6f20e2c55 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RCAHQ.for @@ -7,6 +7,7 @@ C ** WITH WITHDRAWL-RETURN FLOW OPTION DEACTIVATED BY CNWR C C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? USE GLOBAL + USE MPI REAL,ALLOCATABLE,DIMENSION(:)::DZRCA REAL,ALLOCATABLE,DIMENSION(:)::DZZRCA @@ -27,6 +28,7 @@ C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? C C ** WRITE TIME INVARIANT FILES ON FIRST ENTRY C + IF(MYRANK.EQ.0)THEN IF(JSWASP.EQ.0) GOTO 1000 JSWASP=0 OPEN(1,FILE='EFDC.RCA',STATUS='UNKNOWN') @@ -723,6 +725,7 @@ C ENDDO CLOSE(2) ENDIF + ENDIF 200 FORMAT(3I5,6F15.6) 201 FORMAT(' L,I(ROW),J(COL),QX(I,J,K),K=1,KC ',/) 202 FORMAT(' L,I(ROW),J(COL),QY(I,J,K),K=1,KC ',/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index c87a6ec1c..ff1d0c423 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -8,6 +8,7 @@ C ** READ THE EVENT INFORMATION FROM GUI SYSTEM C C USE GLOBAL + USE MPI REAL TXMASS,TXSW,SDAY,EDAY,EVDAY,TLOADTX,TXMASS2,TXVOL REAL TXMASS_3D(KC),TXMASS0(KC) INTEGER ISYEAR,ISMONTH,ISDATE,ISHR,ISMN, @@ -90,7 +91,7 @@ C C PRINT TOXIC TIMESERIES FILE C !{ GeoSR, YSSONG, 101125 - IF(IDTOX.GT.0.AND.IDTOX.LT.4440)THEN ! ONLY FOR TOXIC MODULE + IF(IDTOX.GT.0.AND.IDTOX.LT.4440.AND.MYRANK.EQ.0)THEN ! ONLY FOR TOXIC MODULE !} OPEN(21,FILE='TXSER.INP',STATUS='UNKNOWN') CLOSE(21,STATUS='DELETE') @@ -117,7 +118,7 @@ C CLOSE(21) ENDIF - IF(IDTOX.GT.0.AND.IDTOX.LT.4440)THEN ! ONLY FOR TOXIC MODULE (CWCHO) + IF(IDTOX.GT.0.AND.IDTOX.LT.4440.AND.MYRANK.EQ.0)THEN ! ONLY FOR TOXIC MODULE (CWCHO) OPEN(21,FILE='TOXEVENT.LOG',STATUS='UNKNOWN') WRITE(21,8998) ISYEAR,ISMONTH,ISDATE,ISHR,ISMN WRITE(21,8997) IEVYEAR,IEVMONTH,IEVDATE,IEVHR,IEVMN @@ -131,8 +132,7 @@ C 8995 FORMAT('LOADING PERIOD [MIN] :',I4) 8994 FORMAT('LOADING MASS [g] :',F12.3) ! 2010.12.8 8993 FORMAT('LOADING RATE [KG/S] :',F7.3) - - IF(IDTOX.GE.4440)THEN ! ONLY FOR OIL MODULE(CWCHO 101101) + IF(IDTOX.GE.4440.AND.MYRANK.EQ.0)THEN ! ONLY FOR OIL MODULE(CWCHO 101101) ! [CWCHO, 101203] OPEN(1,FILE='TOX2.INFO',STATUS='UNKNOWN') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for index c9208144c..fa0a156b0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RELAX2T.for @@ -14,6 +14,7 @@ C ** NON-CONVERGENCE IS SIGNALED WHEN THE ITERATIONS EXCEED A C ** MAXIMUM. C USE GLOBAL + USE MPI REAL RPT RPT=0.0 RJ2=RP @@ -69,7 +70,7 @@ C C C ** CHECK MAXIMUM ITERATION CRITERIA C - IF(ITER .GE. ITERM)THEN + IF(ITER .GE. ITERM.AND.MYRANK.EQ.0)THEN WRITE(6,600) WRITE(6,601)RSQ WRITE(8,600) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for index f03326241..f71228f44 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN1.for @@ -5,12 +5,13 @@ C ADDED CODE TO PROPERLY INITIAL RESTART INPUT FOR DRYING AND WETTING C ** SUBROUTINE RESTIN1 READS A RESTART FILE C USE GLOBAL + USE MPI REAL,ALLOCATABLE,DIMENSION(:)::TDUMMY ALLOCATE(TDUMMY(KCM)) TDUMMY=0. C - PRINT *,'READING RESTART FILE: RESTART.INP' + IF(MYRANK.EQ.0) PRINT *,'READING RESTART FILE: RESTART.INP' OPEN(1,FILE='RESTART.INP',STATUS='UNKNOWN') ISBELVC=0 READ(1,908,ERR=1000)NREST @@ -408,7 +409,6 @@ C C C *** DSLLC END BLOCK C - PRINT *,'READING RESTART FILE: TEMP.RST' OPEN(1,FILE='TEMP.RST',STATUS='UNKNOWN') DO L=2,LA READ(1,*)LDUM,IDUM,JDUM,(TDUMMY(K),K=1,KC),TEMB(L) @@ -512,19 +512,23 @@ C ENDDO ENDIF IF(ISDRY.EQ.99)THEN - PRINT *,'READING RESTART FILE: RSTWD.INP' + IF(MYRANK.EQ.0)PRINT *,'READING RESTART FILE: RSTWD.INP' OPEN(1,FILE='RSTWD.INP',STATUS='UNKNOWN') + IF(MYRANK.EQ.0)THEN OPEN(2,FILE='RSTWD.RCK',STATUS='UNKNOWN') CLOSE(2,STATUS='DELETE') OPEN(2,FILE='RSTWD.RCK',STATUS='UNKNOWN') + ENDIF DO L=2,LA READ(1,*)LDUM,IDUM,JDUM,ISCDRY(L),NATDRY(L), & IMASKDRY(L),SUB(L),SVB(L) + IF(MYRANK.EQ.0)THEN WRITE(2,913)LDUM,IDUM,JDUM,ISCDRY(L),NATDRY(L), & IMASKDRY(L),SUB(L),SVB(L),SUBO(L),SVBO(L) + ENDIF ENDDO CLOSE(1) - CLOSE(2) + IF(MYRANK.EQ.0) CLOSE(2) ENDIF 913 FORMAT(6I10,4F7.3) C @@ -534,6 +538,7 @@ C IF(IMASKDRY(L).EQ.0) LMASKDRY(L)=.TRUE. IF(IMASKDRY(L).GT.0) LMASKDRY(L)=.FALSE. END DO + MPI_IMASKDRY = IMASKDRY C C *** DSLLC END BLOCK C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for index 71446d139..510c36bc4 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN10.for @@ -5,8 +5,9 @@ C ** SUBROUTINE RESTINP READS A RESTART FILE GENERATED BY A C ** PRE SEPTEMBER 8, 1992 VERSION OF EFDC.FOR C USE GLOBAL + USE MPI - PRINT *,'READING RESTIN10 FILE: RESTART.INP' + IF(MYRANK.EQ.0)PRINT *,'READING RESTIN10 FILE: RESTART.INP' OPEN(1,FILE='RESTART.INP',STATUS='UNKNOWN') READ(1,*,ERR=1000)NREST DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for index ff0f1e494..a3b9786ee 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTIN2.for @@ -5,8 +5,9 @@ C ** SUBROUTINE RESTINP READS A RESTART FILE FOR (KC/2) LAYERS AND C ** AND INITIALIZES FOR KC LAYERS C USE GLOBAL + USE MPI - PRINT *,'READING RESTIN2 FILE: RESTART.INP' + IF(MYRANK.EQ.0)PRINT *,'READING RESTIN2 FILE: RESTART.INP' OPEN(1,FILE='RESTART.INP',STATUS='UNKNOWN') READ(1,908,ERR=1000)NREST DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for index 3466aae81..bd4326d70 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for @@ -6,6 +6,7 @@ C ADD OUTPUT OF BED LOAD TRANSPORT QSBDLDX QSBDLDY C ** SUBROUTINE RESTOUT WRITES A RESTART FILE C USE GLOBAL + USE MPI CHARACTER*64 RESTFN ! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 REAL HPRES(LCM),H1PRES(LCM),HWQRES(LCM),H2WQRES(LCM) ! NEG. DEP.: JGCHO 2014.9.3 @@ -16,13 +17,165 @@ C ! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.6.3 IF (IRSTYP.EQ.-19) GOTO 7502 ! } GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.6.3 - IF(IRSTYP.EQ.0)THEN + + call collect_in_zero(BELV) + call collect_in_zero(HP) + call collect_in_zero(H1P) + call collect_in_zero(HWQ) + call collect_in_zero(H2WQ) + call collect_in_zero(UHDYE) + call collect_in_zero(UHDY1E) + call collect_in_zero(VHDXE) + call collect_in_zero(VHDX1E) + + do k=0,kcm + call collect_in_zero(QQSQR(:,k)) + call collect_in_zero(QQ(:,k)) + call collect_in_zero(QQ1(:,k)) + call collect_in_zero(QQL(:,k)) + call collect_in_zero(QQL1(:,k)) + call collect_in_zero(DML(:,k)) + enddo + + call collect_in_zero_array(U) + call collect_in_zero_array(U1) + call collect_in_zero_array(V) + call collect_in_zero_array(V1) + + IF(ISCO(1).EQ.1)THEN + call collect_in_zero_array(SAL) + call collect_in_zero_array(SAL1) + ENDIF + IF(ISCO(2).EQ.1)THEN + call collect_in_zero_array(TEM) + call collect_in_zero_array(TEM1) + ENDIF + IF(ISCO(3).EQ.1)THEN + call collect_in_zero_array(DYE) + call collect_in_zero_array(DYE1) + ENDIF + IF(ISCO(4).EQ.1)THEN + call collect_in_zero(SFLSBOT) + call collect_in_zero_array(SFL) + call collect_in_zero_array(SFL2) + ENDIF + IF(ISCO(5).EQ.1)THEN + do nt=1,ntox + call collect_in_zero_array(TOX(:,:,nt)) + call collect_in_zero_array(TOX1(:,:,nt)) + call collect_in_zero_array_kbm(TOXB(:,:,nt)) + call collect_in_zero_array_kbm(TOXB1(:,:,nt)) + enddo + ENDIF + IF(ISCO(6).EQ.1)THEN + do ns=1,nsed + call collect_in_zero_array(SED(:,:,ns)) + call collect_in_zero_array(SED1(:,:,ns)) + call collect_in_zero_array_kbm(SEDB(:,:,ns)) + call collect_in_zero_array_kbm(SEDB1(:,:,ns)) + enddo + ENDIF + IF(ISCO(7).EQ.1)THEN + do ns=1,nsnd + call collect_in_zero_array(SND(:,:,ns)) + call collect_in_zero_array(SND1(:,:,ns)) + call collect_in_zero_array_kbm(SNDB(:,:,ns)) + call collect_in_zero_array_kbm(SNDB1(:,:,ns)) + enddo + ENDIF + IF(ISCO(6).EQ.1.OR.ISCO(7).EQ.1)THEN + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(HBED1) + call collect_in_zero_array_kbm(VDRBED) + call collect_in_zero_array_kbm(VDRBED1) + ENDIF + call collect_in_zero(QSUME) + call collect_in_zero_array(QSUM) + IF(ISGWIE.GE.1)THEN + call collect_in_zero(AGWELV) + call collect_in_zero(AGWELV1) + ENDIF + + CLOS_TMP=CLOS + CLOW_TMP=CLOW + CLOE_TMP=CLOE + CLON_TMP=CLON + NLOS_TMP=NLOS + NLOW_TMP=NLOW + NLOE_TMP=NLOE + NLON_TMP=NLON + + DO K=1,KCM + DO LL=1,NBBSM + IF(.NOT.ISDOMAIN(LCBS(LL)))THEN + CLOS_TMP(LL,K,1:NSTVM)=0. + NLOS_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBWM + IF(.NOT.ISDOMAIN(LCBW(LL)))THEN + CLOW_TMP(LL,K,1:NSTVM)=0. + NLOW_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBEM + IF(.NOT.ISDOMAIN(LCBE(LL)))THEN + CLOE_TMP(LL,K,1:NSTVM)=0. + NLOE_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBNM + IF(.NOT.ISDOMAIN(LCBN(LL)))THEN + CLON_TMP(LL,K,1:NSTVM)=0. + NLON_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + CALL MPI_ALLREDUCE(CLOS_TMP,CLOS,NBBSM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLOW_TMP,CLOW,NBBWM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLOE_TMP,CLOE,NBBEM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLON_TMP,CLON,NBBNM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOS_TMP,NLOS,NBBSM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOW_TMP,NLOW,NBBWM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOE_TMP,NLOE,NBBEM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLON_TMP,NLON,NBBNM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + +CGEO if(myrank.eq.0)THEN +CGEO print*, n,'NLOS1',sum(NLOS) +CGEO print*, n,'CLOS1',sum(CLOS) +CGEO print*, n,'NLOW1',sum(NLOW) +CGEO print*, n,'CLOW1',sum(CLOW) +CGEO print*, n,'NLOE1',sum(NLOE) +CGEO print*, n,'CLOE1',sum(CLOE) +CGEO print*, n,'NLON1',sum(NLON) +CGEO print*, n,'CLON1',sum(CLON) +CGEO endif + + IF(IRSTYP.EQ.0.AND.MYRANK.EQ.0)THEN PRINT *,'Restart Snapshot @ Timeday: ',TIMEDAY OPEN(99,FILE='RESTART.OUT',STATUS='UNKNOWN') CLOSE(99,STATUS='DELETE') OPEN(99,FILE='RESTART.OUT',STATUS='UNKNOWN') ENDIF - IF(IRSTYP.EQ.1)THEN + IF(IRSTYP.EQ.1.AND.MYRANK.EQ.0)THEN OPEN(99,FILE='CRASHST.OUT',STATUS='UNKNOWN') CLOSE(99,STATUS='DELETE') OPEN(99,FILE='CRASHST.OUT',STATUS='UNKNOWN') @@ -69,6 +222,7 @@ C ELSE TIME=TIMESEC/TCON ENDIF + IF(MYRANK.EQ.0) THEN WRITE(99,909)N,TIME DO L=2,LA !{ NEG. DEP.: JGCHO 2014.9.3 @@ -288,30 +442,40 @@ C ENDDO ENDIF CLOSE(99) + ENDIF C C *** SPECIAL FILES C IF(ISWAVE.GE.1)THEN - OPEN(1,FILE='WVQWCP.OUT',STATUS='UNKNOWN') - CLOSE(1, STATUS='DELETE') - OPEN(1,FILE='WVQWCP.OUT',STATUS='UNKNOWN') - DO L=2,LA - WRITE(1,911)IL(L),JL(L),QQWV1(L),QQWV2(L),QQWV3(L),QQWC(L), - & QQWCR(L),QQ(L,0) - ENDDO - CLOSE(1) + call collect_in_zero(QQWV1) + call collect_in_zero(QQWV2) + call collect_in_zero(QQWV3) + call collect_in_zero(QQWC) + call collect_in_zero(QQWCR) + do k=0,kcm + call collect_in_zero(QQ(:,k)) + enddo ENDIF IF(ISCO(1).GE.1.AND.ISTRAN(1).GT.0)THEN - OPEN(1,FILE='SALT.RST',STATUS='UNKNOWN') - CLOSE(1, STATUS='DELETE') - OPEN(1,FILE='SALT.RST',STATUS='UNKNOWN') - DO L=2,LA - WRITE(1,912)L,IL(L),JL(L),(SAL(L,K),K=1,KC) - ENDDO - CLOSE(1) + call collect_in_zero_array(SAL) ENDIF IF(ISCO(2).GE.1.AND.ISTRAN(2).GT.0)THEN - OPEN(1,FILE='TEMP.RSTO',STATUS='UNKNOWN') + call collect_in_zero_array(TEM) + call collect_in_zero(TEMB) + ENDIF + IF(ISDRY.EQ.99)THEN + call collect_in_zero_int(ISCDRY) + call collect_in_zero_int(NATDRY) + call collect_in_zero_int(IMASKDRY) + call collect_in_zero(SUB) + call collect_in_zero(SVB) + call collect_in_zero(SUBO) + call collect_in_zero(SVBO) + ENDIF +C + IF(MYRANK.EQ.0)THEN + IF(ISWAVE.GE.1)THEN + OPEN(1,FILE='WVQWCP.OUT',STATUS='UNKNOWN') CLOSE(1, STATUS='DELETE') OPEN(1,FILE='TEMP.RSTO',STATUS='UNKNOWN') DO L=2,LA @@ -329,10 +493,17 @@ C ENDDO CLOSE(1) ENDIF + ENDIF C C ** OUTPUT SALINITY AND TEMPATURE DATA ASSIMILATION C - IF(NLCDA.GT.0)THEN +CGEO if(myrank.eq.0)THEN +CGEO print*, n,'FSALASM1',sum(FSALASM) +CGEO print*, n,'FVOLASM1',sum(FVOLASM) +CGEO print*, n,'FTEMASM1',sum(FTEMASM) +CGEO endif +C + IF(NLCDA.GT.0.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='DATAASM.OUT') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='DATAASM.OUT') @@ -344,6 +515,35 @@ C ENDIF 5678 FORMAT(2I6,3E14.5) C + do ns=1,nsed + call collect_in_zero_array_kbm(SEDB(:,:,ns)) + enddo + do ns=1,nsnd + call collect_in_zero_array_kbm(SNDB(:,:,ns)) + enddo + call collect_in_zero_array_kbm(VDRBED) + call collect_in_zero_array_kbm(PORBED) + call collect_in_zero(ZELBEDA) + call collect_in_zero(HBEDA) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero(BELV) + call collect_in_zero(HP) + do ns=1,nsed + call collect_in_zero_array(SED(:,:,ns)) + enddo + do ns=1,nsnd + call collect_in_zero_array(SND(:,:,ns)) + enddo + do nx=1,nsnd + call collect_in_zero(QSBDLDX(:,nx)) + call collect_in_zero(QSBDLDY(:,nx)) + enddo + do nt=1,ntox + call collect_in_zero_array_kbm(TOXB(:,:,nx)) + enddo +C + IF(MYRANK.EQ.0)THEN IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0.AND. & ISDTXBUG.EQ.1.AND.N.EQ.NTS)THEN OPEN(1,FILE='BEDRST.SED') @@ -480,6 +680,7 @@ C ENDDO CLOSE(1) ENDIF + ENDIF C 339 FORMAT(2I5,6F14.5) 101 FORMAT(2I5,18E13.5) 102 FORMAT(10X,18E13.5) @@ -506,6 +707,23 @@ C 339 FORMAT(2I5,6F14.5) ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 7501 CONTINUE ! IF (IRSTYP.EQ.-20) GOTO 7501 + call collect_in_zero(HP) + call collect_in_zero_array(UHDY2) + call collect_in_zero_array(VHDX2) + call collect_in_zero_array(W2) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + + call collect_in_zero_array(SAL) + call collect_in_zero_array(TEM) + do ns=1,nsed + call collect_in_zero_array(SED(:,:,ns)) + enddo + +CGEO if(myrank.eq.0)THEN +CGEO print*, n,'QCTLT',sum(QCTLT) +CGEO endif + IF(MYRANK.EQ.0)THEN IF (IRSTYP.LE.-20 .AND. ISRESTO.LE.-20) THEN IF(IRSTYP.EQ.-20)THEN OPEN(7510,FILE='EE_HYDRO.OUT',STATUS='UNKNOWN') @@ -572,11 +790,154 @@ C 339 FORMAT(2I5,6F14.5) CALL FLUSH(7510) CLOSE(7510,STATUS='KEEP') ENDIF + ENDIF ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 ! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 7502 CONTINUE ! IF (IRSTYP.EQ.-19) GOTO 7502 - IF (IRSTYP.EQ.-19) THEN + call collect_in_zero(HP) + call collect_in_zero(H1P) + call collect_in_zero(HWQ) + call collect_in_zero(H2WQ) + + call collect_in_zero(UHDYE) + call collect_in_zero(UHDY1E) + call collect_in_zero(VHDXE) + call collect_in_zero(VHDX1E) + + call collect_in_zero_array(U) + call collect_in_zero_array(U1) + call collect_in_zero_array(V) + call collect_in_zero_array(V1) + + do k=0,kcm + call collect_in_zero(QQSQR(:,k)) + call collect_in_zero(QQ(:,k)) + call collect_in_zero(QQ1(:,k)) + call collect_in_zero(QQL(:,k)) + call collect_in_zero(QQL1(:,k)) + call collect_in_zero(DML(:,k)) + enddo + + IF(ISCO(1).EQ.1)THEN + call collect_in_zero_array(SAL) + call collect_in_zero_array(SAL1) + ENDIF + IF(ISCO(2).EQ.1)THEN + call collect_in_zero_array(TEM) + call collect_in_zero_array(TEM1) + ENDIF + IF(ISCO(3).EQ.1)THEN + call collect_in_zero_array(DYE) + call collect_in_zero_array(DYE1) + ENDIF + IF(ISCO(4).EQ.1)THEN + call collect_in_zero(SFLSBOT) + call collect_in_zero_array(SFL) + call collect_in_zero_array(SFL2) + ENDIF + IF(ISCO(5).EQ.1)THEN + do nt=1,ntox + call collect_in_zero_array(TOX(:,:,nt)) + call collect_in_zero_array(TOX1(:,:,nt)) + call collect_in_zero_array_kbm(TOXB(:,:,nt)) + call collect_in_zero_array_kbm(TOXB1(:,:,nt)) + enddo + ENDIF + IF(ISCO(6).EQ.1)THEN + do ns=1,nsed + call collect_in_zero_array(SED(:,:,ns)) + call collect_in_zero_array(SED1(:,:,ns)) + call collect_in_zero_array_kbm(SEDB(:,:,ns)) + call collect_in_zero_array_kbm(SEDB1(:,:,ns)) + enddo + ENDIF + IF(ISCO(7).EQ.1)THEN + do ns=1,nsnd + call collect_in_zero_array(SND(:,:,ns)) + call collect_in_zero_array(SND1(:,:,ns)) + call collect_in_zero_array_kbm(SNDB(:,:,ns)) + call collect_in_zero_array_kbm(SNDB1(:,:,ns)) + enddo + ENDIF + IF(ISCO(6).EQ.1.OR.ISCO(7).EQ.1)THEN + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(HBED1) + call collect_in_zero_array_kbm(VDRBED) + call collect_in_zero_array_kbm(VDRBED1) + ENDIF + + call collect_in_zero(QSUME) + call collect_in_zero_array(QSUM) + IF(ISGWIE.GE.1)THEN + call collect_in_zero(AGWELV) + call collect_in_zero(AGWELV1) + ENDIF + + CLOS_TMP=CLOS + CLOW_TMP=CLOW + CLOE_TMP=CLOE + CLON_TMP=CLON + NLOS_TMP=NLOS + NLOW_TMP=NLOW + NLOE_TMP=NLOE + NLON_TMP=NLON + + DO K=1,KCM + DO LL=1,NBBSM + IF(.NOT.ISDOMAIN(LCBS(LL)))THEN + CLOS_TMP(LL,K,1:NSTVM)=0. + NLOS_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBWM + IF(.NOT.ISDOMAIN(LCBW(LL)))THEN + CLOW_TMP(LL,K,1:NSTVM)=0. + NLOW_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBEM + IF(.NOT.ISDOMAIN(LCBE(LL)))THEN + CLOE_TMP(LL,K,1:NSTVM)=0. + NLOE_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + DO K=1,KCM + DO LL=1,NBBNM + IF(.NOT.ISDOMAIN(LCBN(LL)))THEN + CLON_TMP(LL,K,1:NSTVM)=0. + NLON_TMP(LL,K,1:NSTVM)=0 + ENDIF + ENDDO + ENDDO + + CALL MPI_ALLREDUCE(CLOS_TMP,CLOS,NBBSM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLOW_TMP,CLOW,NBBWM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLOE_TMP,CLOE,NBBEM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(CLON_TMP,CLON,NBBNM*KCM*NSTVM, + & MPI_REAL,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOS_TMP,NLOS,NBBSM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOW_TMP,NLOW,NBBWM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLOE_TMP,NLOE,NBBEM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + CALL MPI_ALLREDUCE(NLON_TMP,NLON,NBBNM*KCM*NSTVM, + & MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + + IF(MYRANK.EQ.0)THEN + IF(IRSTYP.EQ.-19) THEN WRITE(*,'(A,F10.6,2x,i3.3)')'Restart Snapshot @ Timeday: ' & ,TIMEDAY,NINT(TIMEDAY) @@ -727,7 +1088,7 @@ C 339 FORMAT(2I5,6F14.5) WRITE(99,907)(CLON(LL,K,M),K=1,KC) ENDDO ENDDO - ENDIF + ENDIF IF(ISCO(6).EQ.1)THEN DO NT=1,NSED M=MSVSED(NT) @@ -760,7 +1121,7 @@ C 339 FORMAT(2I5,6F14.5) WRITE(99,907)(CLON(LL,K,M),K=1,KC) ENDDO ENDDO - ENDIF + ENDIF IF(ISCO(7).EQ.1)THEN DO NT=1,NSND M=MSVSND(NT) @@ -809,9 +1170,23 @@ C 339 FORMAT(2I5,6F14.5) ENDDO ENDIF CLOSE(99) + ENDIF + ENDIF C C *** SPECIAL FILES C + call collect_in_zero_array(SAL) + call collect_in_zero_array(TEM) + call collect_in_zero(TEMB) + call collect_in_zero_int(ISCDRY) + call collect_in_zero_int(NATDRY) + call collect_in_zero_int(IMASKDRY) + call collect_in_zero(SUB) + call collect_in_zero(SVB) + call collect_in_zero(SUBO) + call collect_in_zero(SVBO) +C + IF(MYRANK.EQ.0)THEN IF(ISWAVE.GE.1)THEN WRITE(RESTFN,'(A,I3.3,A)') 'WVQWCP',NINT(TIMEDAY),'.OUT' OPEN(1,FILE=TRIM(RESTFN),STATUS='UNKNOWN') @@ -858,9 +1233,37 @@ C ENDDO ENDDO ENDIF - + ENDIF C - IF(ISTRAN(6).GT.0 .OR. ISTRAN(7).GT.0 .AND. + do ns=1,nsed + call collect_in_zero_array_kbm(SEDB(:,:,ns)) + enddo + do ns=1,nsnd + call collect_in_zero_array_kbm(SNDB(:,:,ns)) + enddo + call collect_in_zero_array_kbm(VDRBED) + call collect_in_zero_array_kbm(PORBED) + call collect_in_zero(ZELBEDA) + call collect_in_zero(HBEDA) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero(BELV) + call collect_in_zero(HP) + do ns=1,nsed + call collect_in_zero_array(SED(:,:,ns)) + enddo + do ns=1,nsnd + call collect_in_zero_array(SND(:,:,ns)) + enddo + do nx=1,nsnd + call collect_in_zero(QSBDLDX(:,nx)) + call collect_in_zero(QSBDLDY(:,nx)) + enddo + do nt=1,ntox + call collect_in_zero_array_kbm(TOXB(:,:,nx)) + enddo + IF(MYRANK.EQ.0)THEN + IF(ISTRAN(6).GT.0 .OR. ISTRAN(7).GT.0 .AND. & ISDTXBUG.EQ.1.AND.N.EQ.NTS)THEN WRITE(RESTFN,'(A,I3.3,A)') 'BEDRST',NINT(TIMEDAY),'.SED' @@ -988,8 +1391,7 @@ C ENDDO CLOSE(1) ENDIF - - ENDIF ! IF (IRSTYP.EQ.-19) THEN + ENDIF ! } GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for index 7cb983ba2..d871d0e0f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/ROUT3D.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER *12 SALFN,TEMFN,DYEFN,SEDFN,UUUFN,VVVFN,WWWFN, & CMPFN,SNDFN,TOXFN @@ -16,6 +17,7 @@ C C C ** INITIALIZE OUTPUT FILES C + IF(MYRANK.EQ.0)THEN IAD=I3DMAX-I3DMIN+1 JAD=J3DMAX-J3DMIN+1 NRCAL3D=NRCAL3D+1 @@ -1379,6 +1381,8 @@ C 510 FORMAT(2I5,4(2X,F10.5)) 551 FORMAT(72F7.1) 559 FORMAT(2I4,2X,72I2) CLOSE(50) + ENDIF + RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for index 0558a1b8a..a3058eeae 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTH.for @@ -5,12 +5,14 @@ C ** SUBROUTINE RSALPLTH WRITES FILES FOR RESIDUAL SCALAR FIELD C ** CONTOURING IN HORIZONTAL PLANES C USE GLOBAL + USE MPI DIMENSION DBS(10) CHARACTER*80 TITLE DIMENSION CONC(LCM,KCM) INTEGER LUN LUN=0 C + IF(MYRANK.EQ.0)THEN IF(JSRSPH(ICON).NE.1) GOTO 300 LINES=LA-1 LEVELS=2 @@ -303,6 +305,7 @@ C ENDIF ENDIF CLOSE(LUN) + ENDIF 99 FORMAT(A80) 100 FORMAT(I10,F12.4) 101 FORMAT(2I10) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for index f213abeb9..74b890ca9 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSALPLTV.for @@ -8,6 +8,7 @@ C C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? USE GLOBAL + USE MPI CHARACTER*80 TITLE1,TITLE2,TITLE3 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::ABTMP IF(.NOT.ALLOCATED(ABTMP))THEN @@ -15,6 +16,7 @@ C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? ABTMP=0.0 ENDIF C + IF(MYRANK.EQ.0)THEN IF(ITMP.EQ.2) RETURN IF(ITMP.EQ.3) RETURN IF(ITMP.EQ.4) RETURN @@ -504,6 +506,7 @@ C 101 FORMAT(2I10) 200 FORMAT(2I5,1X,6E14.6) 250 FORMAT(12E12.4) + ENDIF RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for index 03c3d33fd..d09ef55bf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMICI.for @@ -4,6 +4,7 @@ C CHANGE RECORD C READ IN SPATIALLY AND/OR TEMPORALLY VARYING ICS (UNIT INSMICI). C USE GLOBAL + USE MPI CHARACTER TITLE(3)*79,ICICONT*3 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XSMPOC @@ -19,28 +20,34 @@ C XSMPOP=0.0 ENDIF C - PRINT *,'WQ: SD READING WQSDICI.INP' + IF(MYRANK.EQ.0) PRINT *,'WQ: SD READING WQSDICI.INP' OPEN(1,FILE='WQSDICI.INP',STATUS='OLD') OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') IF(ISMTICI.EQ.0)THEN READ(1,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0)THEN WRITE(2,999) WRITE(2,50) (TITLE(M),M=1,3) ENDIF - WRITE(2,60)'* INITIAL CONDITIONS AT ', ISMTICI, - & ' TH DAY FROM MODEL START' + ENDIF READ(1,999) READ(1,50) TITLE(1) + IF(MYRANK.EQ.0)THEN + WRITE(2,60)'* INITIAL CONDITIONS AT ', ISMTICI, + & ' TH DAY FROM MODEL START' WRITE(2,50) TITLE(1) + ENDIF DO M=2,LA READ(1,*) I,J,(XSMPON(NW),NW=1,NSMG), & (XSMPOP(NW),NW=1,NSMG),(XSMPOC(NW),NW=1,NSMG),XSM1NH4, & XSM2NH4,XSM2NO3,XSM2PO4,XSM2H2S,XSMPSI,XSM2SI,XSMBST,XSMT + IF(MYRANK.EQ.0)THEN WRITE(2,90) I,J,(XSMPON(NW),NW=1,NSMG), & (XSMPOP(NW),NW=1,NSMG),(XSMPOC(NW),NW=1,NSMG),XSM1NH4, & XSM2NH4,XSM2NO3,XSM2PO4,XSM2H2S,XSMPSI,XSM2SI,XSMBST,XSMT + ENDIF IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN - PRINT*, 'I, J, LINE# = ', I,J,M-1 + IF(MYRANK.EQ.0) PRINT*, 'I, J, LINE# = ', I,J,M-1 STOP 'ERROR!! INVALID (I,J) IN FILE WQSDICI.INP' ENDIF L=LIJ(I,J) @@ -60,12 +67,14 @@ C SMT(L) =XSMT ENDDO READ(1,52) ISMTICI, ICICONT + IF(MYRANK.EQ.0)THEN WRITE(2,52) ISMTICI, ICICONT + ENDIF IF(ICICONT.EQ.'END')THEN CLOSE(1) ISMICI = 0 ENDIF - CLOSE(2) + IF(MYRANK.EQ.0) CLOSE(2) 999 FORMAT(1X) 50 FORMAT(A79) 52 FORMAT(I7, 1X, A3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for index 922db99bd..354873c0d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSMRST.for @@ -4,6 +4,7 @@ C CHANGE RECORD C READ ICS FROM RESTART FILE FROM INSMRST. C USE GLOBAL + USE MPI LOGICAL FEXIST C C CHECK FIRST TO SEE IF BINARY RESTART FILE EXISTS. IF NOT, USE @@ -11,7 +12,7 @@ C THE ASCII FILE INSTEAD. C INQUIRE(FILE='WQSDRST.BIN', EXIST=FEXIST) IF(.NOT. FEXIST)THEN - PRINT *,'WQ: READING WQSDRST.INP' + IF(MYRANK.EQ.0) PRINT *,'WQ: READING WQSDRST.INP' OPEN(1,FILE='WQSDRST.INP',STATUS='UNKNOWN') READ(1,999) READ(1,999) @@ -23,7 +24,7 @@ C ENDDO CLOSE(1) ELSE - PRINT *,'WQ: READING WQSDRST.BIN' + IF(MYRANK.EQ.0) PRINT *,'WQ: READING WQSDRST.BIN' OPEN(UNIT=1, FILE='WQSDRST.BIN', & FORM='UNFORMATTED', STATUS='UNKNOWN') READ(1) NN_, XTIME diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for index db6b8871f..b1d5518cf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RSURFPLT.for @@ -5,7 +5,9 @@ C ** SUBROUTINE SURFPLT WRITES FILES TO CONTOUR FREE SURFACE C ** ELEVATION C USE GLOBAL + USE MPI CHARACTER*80 TITLE + IF(MYRANK.EQ.0)THEN IF(JSRPPH.NE.1) GOTO 300 OPEN(10,FILE='RSURFCN.OUT',STATUS='UNKNOWN') CLOSE(10,STATUS='DELETE') @@ -33,6 +35,7 @@ C WRITE(10,200)IL(L),JL(L),DLON(L),DLAT(L),SURFEL ENDDO CLOSE(10) + ENDIF 99 FORMAT(A80) 100 FORMAT(I10,F12.4) C 101 FORMAT(2I10) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTH.for index 6ec789c77..c69a56c81 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTH.for @@ -7,12 +7,14 @@ C C *** PMC THIS ROUTINE USES HMP, THE STATIC IC DEPTH. SHOULDN'T IT USE HP? USE GLOBAL + USE MPI DIMENSION DBS(10) CHARACTER*80 TITLE1,TITLE2,TITLE3 IF(JSRVPH.NE.1) GOTO 300 C C ** WRITE HEADINGS C + IF(MYRANK.EQ.0)THEN TITLE1='HORIZ EULERIAN MEAN TRANSPORT VELOCITY' TITLE2='HORIZ VECTOR POTENTIAL TRANSPORT VELOCITY' TITLE3='HORIZ MEAN MASS TRANSPORT VELOCITY' @@ -44,7 +46,9 @@ C CLOSE(12) CLOSE(13) JSRVPH=0 + ENDIF 300 CONTINUE + IF(MYRANK.EQ.0)THEN IF(ISDYNSTP.EQ.0)THEN TIME=DT*FLOAT(N)+TCON*TBEGIN TIME=TIME/TCON @@ -91,6 +95,7 @@ C CLOSE(11) CLOSE(12) CLOSE(13) + ENDIF 99 FORMAT(A80) 100 FORMAT(I10,F12.4) 101 FORMAT(2I10) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTV.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTV.for index 3c9c52b7b..15c17259b 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTV.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RVELPLTV.for @@ -6,6 +6,7 @@ C ** OF VELOCITY NORMAL TO AN ARBITARY SEQUENCE OF (I,J) POINTS AND C ** AND VERTICAL PLANE TANGENTIAL-VERTICAL VELOCITY VECTORS C USE GLOBAL + USE MPI CHARACTER*80 TITLE10,TITLE20,TITLE30 CHARACTER*80 TITLE40,TITLE50,TITLE60 @@ -21,6 +22,7 @@ C REAL,ALLOCATABLE,DIMENSION(:,:)::RLVELT REAL,ALLOCATABLE,DIMENSION(:,:)::RLW C + IF(MYRANK.EQ.0)THEN ALLOCATE(RVELN(KCM,100)) ALLOCATE(RVELT(KCM,100)) ALLOCATE(RW(KCM,100)) @@ -556,6 +558,7 @@ C 101 FORMAT(2I10) 200 FORMAT(2I5,1X,6E14.6) 250 FORMAT(12E12.4) + ENDIF RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for index 6012c6b92..7685e43a0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQAGR.for @@ -6,28 +6,33 @@ C GROWTH, RESP. & PREDATION RATES, AND BASE LIGHT EXTINCT. COEFF. C (UNIT INWQAGR). C USE GLOBAL + USE MPI CHARACTER TITLE(3)*79, AGRCONT*3 OPEN(7890,FILE=AGRFN,STATUS='UNKNOWN') open(7891,FILE='WQALGGX.INP',STATUS='UNKNOWN') + IF(MYRANK.EQ.0)THEN OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF IF(AGRDAY.EQ.0)THEN READ(7890,50) (TITLE(M),M=1,3) - WRITE(2,999) - WRITE(2,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,50) (TITLE(M),M=1,3) ! Also write X-species if present if (NXSP.gt.0) then READ(7891,50) (TITLE(M),M=1,3) - write(2,*) '%%%% X-Species START %%%%' - WRITE(2,50) (TITLE(M),M=1,3) - write(2,*) '%%%% X-Species END %%%%' + IF(MYRANK.EQ.0) WRITE(2,*) '%%%% X-Species START %%%%' + IF(MYRANK.EQ.0) WRITE(2,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0) WRITE(2,*) '%%%% X-Species END %%%%' endif ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,60)'* ALGAL KINETIC VALUE AT', TIMTMP, ! GEOSR DAY read jgcho 2016.10.06 & ' TH DAY FROM MODEL START' + ENDIF READ(7890,999) READ(7890,50) TITLE(1) - WRITE(2,50) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,50) TITLE(1) DO I=1,IWQZ C C READ(1,51) MM,WQPMC(I),WQPMD(I),WQPMG(I),WQBMRC(I), @@ -35,35 +40,37 @@ C READ(7890,*) MM, WQPMC(I),WQPMD(I),WQPMG(I),WQPMM(I),WQBMRC(I), & WQBMRD(I),WQBMRG(I),WQBMRM(I),WQPRRC(I),WQPRRD(I), & WQPRRG(I),WQPRRM(I),WQKEB(I) + IF(MYRANK.EQ.0)THEN WRITE(2,51) MM, WQPMC(I),WQPMD(I),WQPMG(I),WQPMM(I),WQBMRC(I), & WQBMRD(I),WQBMRG(I),WQBMRM(I),WQPRRC(I),WQPRRD(I), & WQPRRG(I),WQPRRM(I),WQKEB(I) + ENDIF ENDDO READ(7890,*) AGRDAY, AGRCONT - WRITE(2,*) AGRDAY, AGRCONT + IF(MYRANK.EQ.0) WRITE(2,*) AGRDAY, AGRCONT ! Repeat for x-species if present if (NXSP.gt.0) then - WRITE(2,*) '%%%% X-Species START %%%%' - WRITE(2,60)'* ALGAL KINETIC VALUE AT', TIMTMP, + IF(MYRANK.EQ.0) WRITE(2,*) '%%%% X-Species START %%%%' + IF(MYRANK.EQ.0) WRITE(2,60)'* ALGAL KINETIC VALUE AT', TIMTMP, & ' TH DAY FROM MODEL START' READ(7891,999) READ(7891,50) TITLE(1) DO I=1,IWQZ READ(7891,*) MM, (WQPMX(I,nsp),nsp=1,NXSP) & ,(WQBMRX(I,nsp),nsp=1,NXSP),(WQPRRX(I,nsp),nsp=1,NXSP) - WRITE(2,51) MM, (WQPMX(I,nsp),nsp=1,NXSP) + IF(MYRANK.EQ.0) WRITE(2,51) MM, (WQPMX(I,nsp),nsp=1,NXSP) & ,(WQBMRX(I,nsp),nsp=1,NXSP),(WQPRRX(I,nsp),nsp=1,NXSP) ENDDO READ(7891,*) AGRDAY, AGRCONT - WRITE(2,*) AGRDAY, AGRCONT - write(2,*) '%%%% X-Species END %%%%' + IF(MYRANK.EQ.0) WRITE(2,*) AGRDAY, AGRCONT + IF (MYRANK.EQ.0) write(2,*) '%%%% X-Species END %%%%' endif IF(AGRCONT.EQ.'END')THEN CLOSE(7890) if (NXSP.gt.0) CLOSE(7891) IWQAGR = 0 ENDIF - CLOSE(2) + IF(MYRANK.EQ.0) CLOSE(2) 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I8, 100F8.3) ! Note, this might need some attention diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM.for index 50005ca47..17e208a12 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQATM.for @@ -6,6 +6,7 @@ C ** FOR THE 22 STATE VARIABLES MULTIPLIED BY THE RAINFALL FLOW RATE !VB CHANG C ** ENTERING EACH GRID CELL. COMPUTED LOADS ARE IN G/DAY. C USE GLOBAL + USE MPI C C CV2 = CONVERSION TO GET UNITS OF G/DAY C WQATM(NW) HAS UNITS OF MG/L @@ -20,6 +21,7 @@ C WQATML(L,KC,NW)=WQATM(NW)*RAINT(L)*DXYP(L)*CV2 ENDDO ENDDO + IF(MYRANK.EQ.0)THEN IF(ITNWQ.EQ.0.AND.DEBUG)THEN OPEN(1,FILE='WQATM.DIA',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') @@ -35,6 +37,7 @@ C ENDDO CLOSE(1) ENDIF + ENDIF 110 FORMAT(1X,2I4,2X,1P,7E11.3,/,15X,7E11.3,/,15X,7E11.3) 112 FORMAT('# WET ATMOSPHERIC DEPOSITION DIAGNOSTIC FILE',/, & ' N, TIME = ', I10, F12.5/) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for index bc062844c..f89a24d4e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQBEN2.for @@ -15,6 +15,7 @@ C 350.00000 <-- DAY AT WHICH FOLLOWING FLUXES BECOME ACTIVE C 9999.99999 <-- ENTER LARGE DAY AT END OF FILE C USE GLOBAL + USE MPI CHARACTER TITLE(3)*79, CCMRM*1 INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IZONE @@ -45,13 +46,15 @@ C ENDIF C OPEN(1,FILE=BENFN,STATUS='UNKNOWN') + IF(MYRANK.EQ.0)THEN OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF C C SKIP OVER THREE HEADER RECORDS: C READ(1,50) (TITLE(M),M=1,3) - WRITE(2,999) - WRITE(2,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,50) (TITLE(M),M=1,3) C C SKIP OVER ALL COMMENT CARDS AT BEGINNING OF FILE: C @@ -59,7 +62,20 @@ C CCMRM = '#' CALL SKIPCOMM(1, CCMRM) READ(1, *) IBENZ - WRITE(2, 65) TIMTMP, IBENZ +!{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 + IF(IBENZ.LT.NSMZ)THEN + IF(MYRANK.EQ.0) WRITE(*,*) 'ERROR : IBENZ(WQBENFLX.INP) + & SHOLUD BE LESS THAN NSMZ WQ3DWC.INP' + PRINT *, "Application suspended. Hit ENTER to continue" + READ(*,*) + ENDIF + IF(IWQBENOX.NE.0.AND.IBENZ.LT.3)THEN + IF(MYRANK.EQ.0) WRITE(*,*) 'ERROR : IBENZ(WQBENFLX.INP) + & MUST BE 3' + PRINT *, "Application suspended. Hit ENTER to continue" + READ(*,*) + ENDIF + IF(MYRANK.EQ.0) WRITE(2, 65) TIMTMP, IBENZ 65 FORMAT(' * BENTHIC FLUXES AT ', F10.5,' DAYS OF MODEL RUN',/, & ' NUMBER OF BENTHIC FLUX ZONES = ', I4) C @@ -80,20 +96,23 @@ C C C UNEXPECTED END-OF-FILE ENCOUNTERED: C - 15 WRITE(2,16) BENFN + 15 CONTINUE + IF(MYRANK.EQ.0) WRITE(2,16) BENFN 16 FORMAT(//,' ************* WARNING *************',/, & ' END-OF-FILE ENCOUNTERED IN FILE: ', A20,/,/ & ' BENTHIC FLUXES SET TO VALUES CORRESPONDING ', & ' TO LAST DAY IN FILE.',/) BENDAY=(TCON*TBEGIN + NTC*TIDALP)/86400.0 ! *** PMC SINGLE LINE 20 CONTINUE - WRITE(2, 48) BDAY + IF(MYRANK.EQ.0) WRITE(2, 48) BDAY 48 FORMAT(/,' DAY IN BENTHIC FLUX FILE: ',F10.5,/, & ' ZONE FPO4 FNH4 FNO3 FSAD FCOD FSOD') DO I=1,IBENZ MM = IZONE(I) + IF(MYRANK.EQ.0) THEN WRITE(2,51) MM,XBFPO4D(MM),XBFNH4(MM),XBFNO3(MM),XBFSAD(MM), & XBFCOD(MM),XBFO2(MM) + ENDIF ENDDO C C DETERMINE BENTHIC FLUX FOR EACH CELL (L) BY INTERPOLATING BETWEEN @@ -127,7 +146,7 @@ C WQBFO2(L) = XM*XBFO2(IZM) + (1.0-XM)*XBFO2(IZS) ENDIF ENDDO CLOSE(1) - CLOSE(2) + IF(MYRANK.EQ.0)CLOSE(2) 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I8, 10F8.3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index 852e3d6d6..383ca6646 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -6,6 +6,7 @@ C: I/O CONTROL VARIABLES C: SPATIALLY AND TEMPORALLY CONSTANT REAL PARAMETERS C USE GLOBAL + USE MPI C IMPLICIT NONE @@ -53,9 +54,11 @@ C XPSL=0.0 ENDIF - - OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') - PRINT *,'WQ: READING WQ3DWC.INP - MAIN WATER QUALITY CONTROL FILE' + IF(MYRANK.EQ.0)THEN + OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') ! GEOSR jgcho 2015.9.10 + ENDIF + IF(MYRANK.EQ.0) PRINT *, + & 'WQ: READING WQ3DWC.INP - MAIN WATER QUALITY CONTROL FILE' OPEN(1,FILE='WQ3DWC.INP',STATUS='UNKNOWN') C C READ FIRST LINE IN WQ3DWC.INP FILE. IF FIRST CHARACTER IS '#', THEN @@ -72,29 +75,29 @@ C CCMRM = '#' IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) (TITLE(M), M=1,3) - WRITE(2,90) (TITLE(M), M=1,3) + IF(MYRANK.EQ.0) WRITE(2,90) (TITLE(M), M=1,3) C C I/O CONTROL VARIABLES C READ(1,999) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) ISWQLVL,NWQV,NWQZ,NWQPS,NWQTD,NWQTS,NTSWQV,NSMG,NSMZ, & NTSSMV,NSMTS,NWQKDPT - WRITE(2,*) ISWQLVL,NWQV,NWQZ,NWQPS,NWQTD,NWQTS,NTSWQV,NSMG,NSMZ, - & NTSSMV,NSMTS,NWQKDPT + IF(MYRANK.EQ.0) WRITE(2,*) ISWQLVL,NWQV,NWQZ,NWQPS,NWQTD,NWQTS, + & NTSWQV,NSMG,NSMZ,NTSSMV,NSMTS,NWQKDPT IF(ISWQLVL.LT.0.OR.ISWQLVL.GT.4)STOP 'BAD KINETICS OPTION' ! *** PMC C *** C02A ! *** ONLY USED WHEN ISWQLVL=1-3 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) (ISTRWQ(NW),NW=1,NWQV) - WRITE(2,*) (ISTRWQ(NW),NW=1,NWQV) + IF(MYRANK.EQ.0) WRITE(2,*) (ISTRWQ(NW),NW=1,NWQV) IF(ISWQLVL.EQ.0)THEN DO NW=1,NWQV ISTRWQ(NW)=0 @@ -108,36 +111,45 @@ C *** C03 IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) IWQDT,IWQM,IWQBEN,IWQSI,IWQFCB,IWQSRP,IWQSTOX, & IWQKA(1), IWQVLIM - WRITE(2,*) IWQDT,IWQM,IWQBEN,IWQSI,IWQFCB,IWQSRP,IWQSTOX, - & IWQKA(1), IWQVLIM + IF(MYRANK.EQ.0) WRITE(2,*) IWQDT,IWQM,IWQBEN,IWQSI,IWQFCB, + & IWQSRP,IWQSTOX,IWQKA(1), IWQVLIM C *** C04 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) IWQZ,IWQNC,IWQRST,NDMWQ,LDMWQ,NDDOAVG,NDLTAVG,IDNOTRVA + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQZ,IWQNC,IWQRST,NDMWQ,LDMWQ,NDDOAVG,NDLTAVG,IDNOTRVA + ENDIF C *** C05 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) IWQICI,IWQAGR,IWQSTL,IWQSUN,IWQPSL,IWQNPL, ISDIURDO, & WQDIUDT, IWQKIN + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQICI,IWQAGR,IWQSTL,IWQSUN,IWQPSL,IWQNPL, ISDIURDO, & WQDIUDT, IWQKIN + ENDIF IWQDIUDT = NINT(WQDIUDT*3600.0/DT) + IF(MYRANK.EQ.0)THEN WRITE(2,83)': FREQUENCY OF DIURNAL DO OUTPUT (IN DT UNIT) =', & IWQDIUDT WRITE(2,83)'* IWQDT (DTWQ(D) = DT(S)*IWQDT/86400) = ', & IWQDT + ENDIF DTD = DT/86400.0 C DTWQ = DTD*REAL(IWQDT)*REAL(NWQKDPT) PMC DTWQ = DTD*REAL(NWQKDPT) DTWQO2 = DTWQ*0.5 !IF(IWQM.EQ.1)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* FULL VERSION WITH 21 VARIABLES IS ACTIVATED ' + ENDIF !ELSE IF(IWQM.EQ.2)THEN !STOP 'SMALL VERSION WITH 9 VARIABLES IS NOT OPERATIONAL, STOPPING' !ELSE !STOP '** ERROR!!! INVALID IWQM VALUE **' !ENDIF + IF(MYRANK.EQ.0)THEN IF(IWQBEN.EQ.1)THEN WRITE(2,80)'* SEDIMENT PROCESS MODEL IS ACTIVATED ' ELSE IF(IWQBEN.EQ.0)THEN @@ -243,13 +255,16 @@ C DTWQ = DTD*REAL(IWQDT)*REAL(NWQKDPT) PMC WRITE(2,80)'* FILE KINETICS.INP NOT USED ' ENDIF WRITE(2,999) + ENDIF C *** C06 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) IWQTS,TWQTSB,TWQTSE,WQTSDT, ISWQAVG, ISWQMIN, ISWQMAX, & ISCOMP + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQTS,TWQTSB,TWQTSE,WQTSDT, ISWQAVG, ISWQMIN, ISWQMAX, & ISCOMP + ENDIF C C ISWQAVG > 0 TURNS ON BINARY FILE OUTPUT FOR WQ DAILY AVERAGES C ISWQMIN > 0 TURNS ON BINARY FILE OUTPUT FOR WQ DAILY MINIMUMS @@ -261,13 +276,16 @@ C IF(ISCOMP .GT. 0)THEN CALL WQZERO3 C CALL INITBIN3 - CALL INITBIN5 + IF(MYRANK.EQ.0) CALL INITBIN5 !} ENDIF IF(IWQTS.GT.NWQTS)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,80)'** IWQTS SHOULD BE <= NWQTS ** ' + ENDIF IWQTS=NWQTS ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,84) & '* TIME-SERIES OUTPUT FROM ', TWQTSB, ' DAY ', & ' TO ', TWQTSE, ' DAY ', @@ -278,6 +296,7 @@ C CALL INITBIN3 & ' BIN FILE SWITCH ISWQMAX =', ISWQMAX,' (0=OFF) ', & ' BIN FILE SWITCH ISCOMP =', ISCOMP, ' (0=OFF) ' WRITE(2,999) + ENDIF C *** C07 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) @@ -285,16 +304,19 @@ C *** C07 READ(1,90) TITLE(M) ENDDO IF(IWQTS.GE.1)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,80)': ICWQTS(I)=1, TIME-SERIES OUTPUT FOR VARIABLE I ' WRITE(2,80)': ICWQTS(I)\=1, NO TIME-SERIES OUTPUT FOR VAR. I ' WRITE(2,999) DO M=1,2 WRITE(2,90) TITLE(M) ENDDO + ENDIF DO M=1,IWQTS READ(1,*) II,JJ,(ICWQTS(NW,M),NW=1,13) + READ(1,*) (ICWQ TS(NW,M),NW=14,NTSWQV),ICWQTS(IDNOTRVA,M) + IF(MYRANK.EQ.0)THEN WRITE(2,*) II,JJ,(ICWQTS(NW,M),NW=1,13) - READ(1,*) (ICWQTS(NW,M),NW=14,NTSWQV),ICWQTS(IDNOTRVA,M) WRITE(2,*) (ICWQTS(NW,M),NW=14,NTSWQV),ICWQTS(IDNOTRVA,M) IF(IJCT(II,JJ).LT.1 .OR. IJCT(II,JJ).GT.8)THEN WRITE(2,86) II,JJ,M @@ -303,6 +325,8 @@ C *** C07 ENDIF LWQTS(M)=LIJ(II,JJ) WRITE(2,94) II,JJ,(ICWQTS(NW,M),NW=1,NTSWQV+1) + ENDIF +! GEOSR X jgcho 2016.02.18 iww(M)=II jww(M)=JJ ENDDO @@ -310,6 +334,7 @@ C *** C07 IWQTSB = NINT(TWQTSB/DTD) IWQTSE = NINT(TWQTSE/DTD) IWQTSDT = NINT(WQTSDT*3600.0/DT) + IF(MYRANK.EQ.0)THEN WRITE(2,999) WRITE(2,83)': TIME-SERIES STARTING TIME STEP (IN DT UNIT) =', & IWQTSB @@ -317,6 +342,7 @@ C *** C07 & IWQTSE WRITE(2,83)': FREQUENCY OF TS OUTPUT (IN DT UNIT) =', & IWQTSDT + ENDIF C PMC IF(MOD(IWQTSDT,IWQDT).NE.0) C PMC & STOP 'ERROR!! IWQTSDT SHOULD BE MULTIPLE OF IWQDT' 999 FORMAT(1X) @@ -336,14 +362,19 @@ C C CONSTANT PARAMETERS FOR ALGAE (SEE TABLE 3-1) C8 C + IF(MYRANK.EQ.0)THEN WRITE(2,999) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQKHNC,WQKHND,WQKHNG,WQKHNM,WQKHPC,WQKHPD,WQKHPG, & WQKHPM,WQKHS,WQSTOX + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQKHNC,WQKHND,WQKHNG,WQKHNM,WQKHPC,WQKHPD,WQKHPG, & WQKHPM,WQKHS,WQSTOX WRITE(2,80)'* HALF-SAT. COSNTANT (G/M^3) FOR NUTRIENT UPTAKE ' @@ -353,6 +384,7 @@ C WRITE(2,81)' : (KHNM, KHPM) = ', WQKHNM,WQKHPM WRITE(2,82)'* SAL. WHERE MICROSYSTIS GROWTH IS HALVED = ', & WQSTOX + ENDIF WQSTOX = WQSTOX*WQSTOX C C9 @@ -363,25 +395,36 @@ C READ(1,95)LINE READ(LINE,*,END=109,ERR=109) WQKETSS,WQKECHL,WQCHLC,WQCHLD,WQCHLG, & WQCHLM,WQDOPC,WQDOPD,WQDOPG, WQDOPM(1), WQKEPOM - 109 WRITE(2,*) WQKETSS,WQKECHL,WQCHLC,WQCHLD,WQCHLG,WQCHLM,WQDOPC, + 109 CONTINUE + IF(MYRANK.EQ.0)THEN + WRITE(2,*) WQKETSS,WQKECHL,WQCHLC,WQCHLD,WQCHLG,WQCHLM,WQDOPC, & WQDOPD,WQDOPG, WQDOPM(1) , WQKEPOM + ENDIF IF(ISTRAN(6).EQ.0)THEN WQKETSS=0.0 + IF(MYRANK.EQ.0)THEN WRITE(2,80)': SINCE TSS IS NOT MODELED, KETSS IS FORCED TO 0 ' ENDIF + ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* LIGHT EXTINC. COEFF. DUE TO TSS, CHL & POM ' WRITE(2,81)' : KETSS (/M PER G/M^3) = ', WQKETSS WRITE(2,81)' : KECHL (/M PER MG/M^3) = ', WQKECHL + ENDIF IF(WQKECHL .LT. 0.0)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,80) '* USE RILEY (1956) EQUATION FOR WQKECHL ' WRITE(2,80) ' : KECHL = 0.054*CHL**0.667 + 0.0088*CHL ' ENDIF + ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,81)' : KEPOM (/M PER G/M^3) = ', WQKEPOM ! *** END DSLLC BLOCK WRITE(2,80)'* CARBON-TO-CHL RATIO (G C PER MG CHL) ' WRITE(2,81)' : (CCHLC, CCHLD, CCHLG) = ', WQCHLC,WQCHLD,WQCHLG WRITE(2,80)'* DEPTH (M) OF MAXIMUM ALGAL GROWTH ' WRITE(2,81)' : (DOPTC, DOPTD, DOPTG) = ', WQDOPC,WQDOPD,WQDOPG + ENDIF WQCHLC=1.0/(WQCHLC+ 1.E-12) WQCHLD=1.0/(WQCHLD+ 1.E-12) WQCHLG=1.0/(WQCHLG+ 1.E-12) @@ -391,6 +434,7 @@ C *** C10 IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQI0,WQISMIN,WQFD,WQCIA,WQCIB,WQCIC,WQCIM,REAC(1), & PARADJ + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQI0,WQISMIN,WQFD,WQCIA,WQCIB,WQCIC,WQCIM,REAC(1), & PARADJ WRITE(2,82)'*INITIAL IO (LY/D) AT WATER SURFACE = ',WQI0 @@ -400,6 +444,7 @@ C *** C10 & ,' WEIGHTING FACTOR FOR RAD. AT (-1) DAY = ',WQCIB & ,' WEIGHTING FACTOR FOR RAD. AT (-2) DAYS = ',WQCIC & ,' FRACTION OF SOLAR RADIATION THAT IS PAR = ',PARADJ + ENDIF WQI0=PARADJ*WQI0 !/(WQFD+1.E-18) ! *** APPLY CONVERSION TO OPTIMAL LIGHT WQI1 = WQI0 WQI2 = WQI0 @@ -413,41 +458,48 @@ C *** C11 IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQTMC1,WQTMC2,WQTMD1,WQTMD2,WQTMG1,WQTMG2,WQTMM1,WQTMM2, & WQTMP1, WQTMP2 + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQTMC1,WQTMC2,WQTMD1,WQTMD2,WQTMG1,WQTMG2,WQTMM1, & WQTMM2,WQTMP1, WQTMP2 + ENDIF C *** C12 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQKG1C,WQKG2C,WQKG1D,WQKG2D,WQKG1G,WQKG2G,WQKG1M,WQKG2M, & WQKG1P, WQKG2P + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQKG1C,WQKG2C,WQKG1D,WQKG2D,WQKG1G,WQKG2G,WQKG1M, & WQKG2M,WQKG1P, WQKG2P WRITE(2,80)'* LOWER OPTIMUM TEMP FOR ALGAL GROWTH (DEGC) ' WRITE(2,81)' : (TMC1, TMD1, TMG1 ) = ', WQTMC1,WQTMD1,WQTMG1 WRITE(2,80)'* UPPER OPTIMUM TEMP FOR ALGAL GROWTH (DEGC) ' WRITE(2,81)' : (TMC2, TMD2, TMG2 ) = ', WQTMC2,WQTMD2,WQTMG2 + ENDIF C C *** C13 CONSTANT PARAMETERS FOR ALGAE (SEE TABLE 3-1) C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQTRC,WQTRD,WQTRG,WQTRM,WQKTBC,WQKTBD,WQKTBG,WQKTBM + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQTRC,WQTRD,WQTRG,WQTRM,WQKTBC,WQKTBD,WQKTBG,WQKTBM WRITE(2,80)'* REFERENCE TEMPERATURE FOR ALGAL METABOLISM (OC) ' WRITE(2,81)' : (TRC, TRD, TRG) = ', WQTRC,WQTRD,WQTRG WRITE(2,80)'* TEMPERATURE EFFECT FOR ALGAL METABOLISM ' WRITE(2,81)' : (KTBC, KTBD, KTBG) = ', WQKTBC,WQKTBD,WQKTBG + ENDIF C C *** C14 CONSTANT PARAMETERS FOR CARBON (SEE TABLE 3-2) C - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFCRP,WQFCLP,WQFCDP,WQFCDC,WQFCDD,WQFCDG, & WQKHRC,WQKHRD,WQKHRG + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFCRP,WQFCLP,WQFCDP,WQFCDC,WQFCDD,WQFCDG, & WQKHRC,WQKHRD,WQKHRG WRITE(2,80)'* CARBON DISTRIBUTION COEFF FOR ALGAL PREDATION ' @@ -456,28 +508,36 @@ C WRITE(2,81)' : (FCDC, FCDD, FCDG) = ', WQFCDC,WQFCDD,WQFCDG WRITE(2,80)'* HALF-SAT. CONSTANT (GO/M*3) FOR ALGAL DOC EXCRET' WRITE(2,81)' : (KHRC, KHRD, KHRG) = ', WQKHRC,WQKHRD,WQKHRG + ENDIF CFCDCWQ = 1.0 - WQFCDC CFCDDWQ = 1.0 - WQFCDD CFCDGWQ = 1.0 - WQFCDG XC = ABS(1.0 - (WQFCRP+WQFCLP+WQFCDP)) + IF(MYRANK.EQ.0)THEN IF(XC .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FCRP+FCLP+FCDP NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF C *** C15 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFCRPM,WQFCLPM,WQFCDPM,WQFCDM, WQKHRM(1) + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFCRPM,WQFCLPM,WQFCDPM,WQFCDM, WQKHRM(1) + ENDIF C *** C16 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQKRC,WQKLC,WQKDC(1),WQKRCALG,WQKLCALG,WQKDCALG, & WQKDCALM(1) + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQKRC,WQKLC,WQKDC(1),WQKRCALG,WQKLCALG,WQKDCALG, & WQKDCALM(1) WRITE(2,80)'* MINIMUM DISSOLUTION RATE (/DAY) OF ORGANIC C ' @@ -485,11 +545,13 @@ C *** C16 WRITE(2,80)'* CONSTANT RELATING DISSOLUTION RATE TO ALGAE ' WRITE(2,81)' : (KRCALG,KLCALG,KDCALG)= ', WQKRCALG,WQKLCALG, & WQKDCALG + ENDIF C *** C17 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQTRHDR,WQTRMNL,WQKTHDR,WQKTMNL,WQKHORDO,WQKHDNN, & WQAANOX + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQTRHDR,WQTRMNL,WQKTHDR,WQKTMNL,WQKHORDO,WQKHDNN, & WQAANOX WRITE(2,80)'* REFERENCE TEMP FOR HYDROLYSIS/MINERALIZATION(OC)' @@ -500,18 +562,24 @@ C *** C17 WRITE(2,81)' : (KHORDO, KHDNN) = ', WQKHORDO,WQKHDNN WRITE(2,80)'* RATION OF DENITRIFICATION TO OXIC DOC RESP ' WRITE(2,81)' : (AANOX) = ', WQAANOX + ENDIF WQAANOX = WQAANOX*WQKHORDO C C *** C18 CONSTANT PARAMETERS FOR PHOSPHORUS (TABLE 3-3) C + IF(MYRANK.EQ.0)THEN WRITE(2,999) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFPRP,WQFPLP,WQFPDP,WQFPIP,WQFPRC,WQFPRD,WQFPRG, & WQFPLC,WQFPLD,WQFPLG + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFPRP,WQFPLP,WQFPDP,WQFPIP,WQFPRC,WQFPRD,WQFPRG, & WQFPLC,WQFPLD,WQFPLG WRITE(2,80)'* PHOSPHORUS DISTRIBUTION COEF FOR ALGAL PREDATION' @@ -521,61 +589,81 @@ C WRITE(2,81)' : (FPRC, FPRD, FPRG) = ', WQFPRC,WQFPRD,WQFPRG WRITE(2,80)'* PHOSPHORUS DIST COEF OF LPOP FOR ALGAL METABOLIS' WRITE(2,81)' : (FPLC, FPLD, FPLG) = ', WQFPLC,WQFPLD,WQFPLG + ENDIF XP = ABS(1.0 - (WQFPRP+WQFPLP+WQFPDP+WQFPIP)) + IF(MYRANK.EQ.0)THEN IF(XP .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FPRP+FPLP+FPDP+FPIP NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF C *** C19 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQFPRPM,WQFPLPM,WQFPDPM,WQFPIPM,WQFPRM,WQFPLM,WQAPCM + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQFPRPM,WQFPLPM,WQFPDPM,WQFPIPM,WQFPRM,WQFPLM,WQAPCM + ENDIF C *** C20 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFPDC,WQFPDD,WQFPDG,WQFPDM,WQFPIC,WQFPID,WQFPIG, & WQFPIM,WQKPO4P + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFPDC,WQFPDD,WQFPDG,WQFPDM,WQFPIC,WQFPID,WQFPIG, & WQFPIM,WQKPO4P + ENDIF IF(IWQSRP.NE.1 .AND. IWQSRP.NE.2)THEN WQKPO4P = 0.0 + IF(MYRANK.EQ.0)THEN WRITE(2,80)': NO SORPTION OF PO4T/SA, SO KPO4P IS FORCED TO 0 ' ENDIF + ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* PHOSPHORUS DIST COEF OF DOP FOR ALGAL METABOLISM' WRITE(2,81)' : (FPDC, FPDD, FPDG) = ', WQFPDC,WQFPDD,WQFPDG WRITE(2,80)'* PHOSPHORUS DIST COEF OF NH4 FOR ALGAL METABOLISM' WRITE(2,81)' : (FPIC, FPID, FPIG) = ', WQFPIC,WQFPID,WQFPIG WRITE(2,82)'* PARITITION COEFF FOR SORBED/DISSOLVED PO4 =', & WQKPO4P + ENDIF XPC = ABS(1.0 - (WQFPRC+WQFPLC+WQFPDC+WQFPIC)) + IF(MYRANK.EQ.0)THEN IF(XPC .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FPRC+FPLC+FPDC+FPIC NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF XPD = ABS(1.0 - (WQFPRD+WQFPLD+WQFPDD+WQFPID)) + IF(MYRANK.EQ.0)THEN IF(XPD .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FPRD+FPLD+FPDD+FPID NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF XPG = ABS(1.0 - (WQFPRG+WQFPLG+WQFPDG+WQFPIG)) + IF(MYRANK.EQ.0)THEN IF(XPG .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FPRG+FPLG+FPDG+FPIG NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF C *** C21 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQKRP,WQKLP,WQKDP,WQKRPALG,WQKLPALG,WQKDPALG,WQCP1PRM, & WQCP2PRM,WQCP3PRM + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQKRP,WQKLP,WQKDP,WQKRPALG,WQKLPALG,WQKDPALG,WQCP1PRM, & WQCP2PRM,WQCP3PRM WRITE(2,80)'* MINIMUM HYDROLYSIS RATE (/DAY) OF ORGANIC P ' @@ -586,17 +674,23 @@ C *** C21 WRITE(2,80)'* CONSTANT USED IN DETERMINING P-TO-C RATIO ' WRITE(2,81)' : (CPPRM1,CPPRM2,CPPRM3)= ', WQCP1PRM,WQCP2PRM, & WQCP3PRM + ENDIF C C *** C22 CONSTANT PARAMETERS FOR NITROGEN (TABLE 3-4) C + IF(MYRANK.EQ.0)THEN WRITE(2,999) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFNRP,WQFNLP,WQFNDP,WQFNIP,WQFNRC,WQFNRD,WQFNRG, & WQFNLC,WQFNLD,WQFNLG + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFNRP,WQFNLP,WQFNDP,WQFNIP,WQFNRC,WQFNRD,WQFNRG, & WQFNLC,WQFNLD,WQFNLG WRITE(2,80)'* NITROGEN DISTRIBUTION COEFF FOR ALGAL PREDATION ' @@ -606,26 +700,34 @@ C WRITE(2,81)' : (FNRC, FNRD, FNRG) = ', WQFNRC,WQFNRD,WQFNRG WRITE(2,80)'* NITROGEN DIST COEF OF LPON FOR ALGAL METABOLISM ' WRITE(2,81)' : (FNLC, FNLD, FNLG) = ', WQFNLC,WQFNLD,WQFNLG + ENDIF XN = ABS(1.0 - (WQFNRP+WQFNLP+WQFNDP+WQFNIP)) + IF(MYRANK.EQ.0)THEN IF(XN .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FNRP+FNLP+FNDP+FNIP NOT EQUAL TO 1.0' WRITE(2,*) ENDIF WRITE(2,999) + ENDIF C *** C23 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQFNRPM,WQFNLPM,WQFNDPM,WQFNIPM,WQFNRM,WQFNLM + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQFNRPM,WQFNLPM,WQFNDPM,WQFNIPM,WQFNRM,WQFNLM + ENDIF C *** C24 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFNDC,WQFNDD,WQFNDG,WQFNDM,WQFNIC,WQFNID,WQFNIG, & WQFNIM,WQANCC,WQANCD,WQANCG,WQANCM + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFNDC,WQFNDD,WQFNDG,WQFNDM,WQFNIC,WQFNID,WQFNIG, & WQFNIM,WQANCC,WQANCD,WQANCG,WQANCM WRITE(2,80)'* NITROGEN DIST COEF OF DON FOR ALGAL METABOLISM ' @@ -634,28 +736,36 @@ C *** C24 WRITE(2,81)' : (FNIC, FNID, FNIG) = ', WQFNIC,WQFNID,WQFNIG WRITE(2,80)'* NITROGEN-TO-CARBON RATIO IN ALGAE ' WRITE(2,81)' : (ANCC, ANCD, ANCG) = ', WQANCC,WQANCD,WQANCG + ENDIF XNC = ABS(1.0 - (WQFNRC+WQFNLC+WQFNDC+WQFNIC)) + IF(MYRANK.EQ.0)THEN IF(XNC .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FNRC+FNLC+FNDC+FNIC NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF XND = ABS(1.0 - (WQFNRD+WQFNLD+WQFNDD+WQFNID)) + IF(MYRANK.EQ.0)THEN IF(XND .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FNRD+FNLD+FNDD+FNID NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF XNG = ABS(1.0 - (WQFNRG+WQFNLG+WQFNDG+WQFNIG)) + IF(MYRANK.EQ.0)THEN IF(XNG .GT. 0.0001)THEN WRITE(2,*) WRITE(2,*) ' WARNING! FNRG+FNLG+FNDG+FNIG NOT EQUAL TO 1.0' WRITE(2,*) ENDIF + ENDIF C *** C25 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQANDC,WQNITM,WQKHNDO,WQKHNN,WQTNIT,WQKN1,WQKN2 + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQANDC,WQNITM,WQKHNDO,WQKHNN,WQTNIT,WQKN1,WQKN2 WRITE(2,82)'* MASS NO3 REDUCED PER DOC OXIDIZED (GN/GC)= ',WQANDC & ,'* MAXIMUM NITRIFICATION RATE (G N /M^3/D) = ',WQNITM @@ -664,29 +774,39 @@ C *** C25 WRITE(2,81)' : (KHNITDO, KHNITN) = ', WQKHNDO,WQKHNN WRITE(2,80)'* SUB & SUPER-OPTIMUM TEMP EFFECT ON NITRIFICATION' WRITE(2,81)' : (KNIT1, KNIT2) = ', WQKN1,WQKN2 + ENDIF C *** C26 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQKRN,WQKLN,WQKDN,WQKRNALG,WQKLNALG,WQKDNALG + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQKRN,WQKLN,WQKDN,WQKRNALG,WQKLNALG,WQKDNALG WRITE(2,80)'* MINIMUM HYDROLYSIS RATE (/DAY) OF ORGANIC N ' WRITE(2,81)' : (KRN, KLN, KDN) = ', WQKRN,WQKLN,WQKDN WRITE(2,80)'* CONSTANT RELATING HYDROLYSIS RATE TO ALGAE ' WRITE(2,81)' : (KRNALG,KLNALG,KDNALG)= ', WQKRNALG,WQKLNALG, & WQKDNALG + ENDIF C C *** C27 CONSTANT PARAMETERS FOR SILICA (TABLE 3-5) C + IF(MYRANK.EQ.0)THEN WRITE(2,999) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,90) TITLE(1) + ENDIF IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQFSPP,WQFSIP,WQFSPD,WQFSID,WQASCD,WQKSAP,WQKSU, & WQTRSUA,WQKTSUA + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQFSPP,WQFSIP,WQFSPD,WQFSID,WQASCD,WQKSAP,WQKSU, & WQTRSUA,WQKTSUA + ENDIF + IF(MYRANK.EQ.0)THEN IF(IWQSRP.NE.1 .AND. IWQSRP.NE.2)THEN WQKSAP = 0.0 WRITE(2,80)': NO SORPTION OF PO4T/SA, SO KSAP IS FORCED TO 0 ' @@ -700,17 +820,19 @@ C & ,'*DISSOLUTION RATE (/D) OF PSI = ',WQKSU & ,' REFERENCE TEMP FOR PSI DISSOLUTION (OC) = ',WQTRSUA & ,' TEMPERATURE EFFECT ON PSI DISSOLUTION = ',WQKTSUA + ENDIF C C *** C28 CONSTANT PARAMETERS FOR COD & DO (TABLE 3-6) -C - WRITE(2,999) +C #### GHYUN + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQAOCR,WQAONT, WQKRO(1), WQKTR(1),WQKHCOD(1),WQKCD(1), & WQTRCOD, WQKTCOD, WQAOCRPM, WQAOCRRM + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQAOCR,WQAONT, WQKRO(1), WQKTR(1),WQKHCOD(1),WQKCD(1), & WQTRCOD, WQKTCOD, WQAOCRPM, WQAOCRRM WRITE(2,82)'* DO-TO-CARBON RATIO IN RESPIRATION = ',WQAOCR @@ -723,17 +845,19 @@ C & ,' TEMPERATURE EFFECT ON COD OXIDATION = ',WQKTCOD & ,': DO-TO-CARBON RATIO MACROALGAE PHOTOSYNTH = ',WQAOCRPM & ,': DO-TO-CARBON RATIO MACROALGAE RESPIRATION= ',WQAOCRRM + ENDIF C C *** C29 CONSTANT PARAMETERS FOR TAM & FCB (TABLE 3-7) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) WQKHBMF,WQBFTAM,WQTTAM,WQKTAM,WQTAMDMX,WQKDOTAM, & WQKFCB,WQTFCB + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQKHBMF,WQBFTAM,WQTTAM,WQKTAM,WQTAMDMX,WQKDOTAM, & WQKFCB,WQTFCB WRITE(2,82) @@ -745,6 +869,7 @@ C & ,' CONSTANT RELATING TAM SOLUBILITY TO DO = ',WQKDOTAM & ,'* FIRST-ORDER DIE-OFF RATE AT 20OC (/D) = ',WQKFCB & ,' TEMPERATURE EFFECT ON BACTERIA DIE-OFF = ',WQTFCB + ENDIF C C SET UP LOOK-UP TABLE FOR TEMPERATURE DEPENDENCY OVER -15 OC TO 40 OC C @@ -817,7 +942,9 @@ C 555 FORMAT(F7.2,4E12.4) WQKCOD(M,1) = WQKCD(1) * EXP( WQKTCOD*(WTEMP-WQTRCOD) ) TT20 = WTEMP-20.0 WQTDKR(M,1) = WQKTR(1)**TT20 + IF(MYRANK.EQ.0)THEN WRITE(2,2222)M,WQKTR(1),WQTDKR(M,1) + ENDIF WQTDTAM(M) = WQKHBMF * WQBFTAM * EXP( WQKTAM*(WTEMP-WQTTAM) ) WQTT = WQKFCB * WQTFCB**TT20 * DTWQO2 WQTD1FCB(M) = 1.0 - WQTT @@ -830,17 +957,19 @@ C *** C30 C READ SECOND PART: RWQC2 C PARAMETERS FOR WATER QUALITY STATE VARIABLE TIME SERIES C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO READ(1,*) (NWQCSR(NW),NW=1,NWQV) + IF(MYRANK.EQ.0)THEN WRITE(2,*) (NWQCSR(NW),NW=1,NWQV) WRITE(2,970)(NWQCSR(NW),NW=1,NWQV) + ENDIF ! *** SAVE THE NUMBER OF WQ TIME SERIES DO NW=1,NWQV NT=4+NTOX+NSED+NSND+NW @@ -851,37 +980,41 @@ C *** C31 C READ SECOND PART: RWQC2 C PARAMETERS FOR OPEN BOUNDARY CONDITIONS C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) NWQOBS,NWQOBW,NWQOBE,NWQOBN + IF(MYRANK.EQ.0)THEN WRITE(2,*) NWQOBS,NWQOBW,NWQOBE,NWQOBN WRITE(2,23)'* # OF OPEN BDRY CELLS ON SOUTH BDRY = ',NWQOBS WRITE(2,23)'* # OF OPEN BDRY CELLS ON WEST BDRY = ',NWQOBW WRITE(2,23)'* # OF OPEN BDRY CELLS ON EAST BDRY = ',NWQOBE WRITE(2,23)'* # OF OPEN BDRY CELLS ON NORTH BDRY = ',NWQOBN + ENDIF IF(NWQOBS.GT.NBBSM) STOP 'ERROR!! NWQOBS SHOULD <= NBBSM' IF(NWQOBW.GT.NBBWM) STOP 'ERROR!! NWQOBW SHOULD <= NBBWM' IF(NWQOBE.GT.NBBEM) STOP 'ERROR!! NWQOBE SHOULD <= NBBEM' IF(NWQOBN.GT.NBBNM) STOP 'ERROR!! NWQOBN SHOULD <= NBBNM' + IF(MYRANK.EQ.0)THEN WRITE(2,999) WRITE(2,80)'* CONSTANT OBC AT (ICBX(M),JCBX(M)) IF IWQOBX(M)=0' WRITE(2,80)': READ TIME-SERIES OBCS IWQOBX TIMES IF IWQOBX > 0' + ENDIF C C *** C32 C SOUTH BDRY C READ(1,90) TITLE(M) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBS.GT.0)THEN DO M=1,NWQOBS @@ -895,19 +1028,21 @@ C ELSE STOP ' WQ: SOUTH OBC: MISS MATCH BETWEEN NCBS & NWQOBS' ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBS(M),JWQCBS(M),(IWQOBS(M,NW),NW=1,NWQV) WRITE(2,969) IWQCBS(M),JWQCBS(M),(IWQOBS(M,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C C *** C33 C: CONSTANT BOTTOM AND SURFACE OBCS C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBS.GT.0)THEN DO M=1,NWQOBS @@ -919,16 +1054,18 @@ C CBS(M,1,NT)=WQOBCS(M,1,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBS(M),JWQCBS(M),(WQOBCS(M,1,NW),NW=1,NWQV) WRITE(2,97) IWQCBS(M),JWQCBS(M),(WQOBCS(M,1,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C *** C34 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBS.GT.0)THEN DO M=1,NWQOBS @@ -940,8 +1077,10 @@ C *** C34 CBS(M,2,NT)=WQOBCS(M,2,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBS(M),JWQCBS(M),(WQOBCS(M,2,NW),NW=1,NWQV) WRITE(2,97) IWQCBS(M),JWQCBS(M),(WQOBCS(M,2,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C @@ -949,13 +1088,13 @@ C *** C35 C WEST BDRY C READ(1,90) TITLE(M) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBW.GT.0)THEN DO M=1,NWQOBW @@ -969,19 +1108,21 @@ C ELSE STOP ' WQ: WST OBC: MISS MATCH BETWEEN NCBW & NWQOBW' ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBW(M),JWQCBW(M),(IWQOBW(M,NW),NW=1,NWQV) WRITE(2,969) IWQCBW(M),JWQCBW(M),(IWQOBW(M,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C C *** C36 C: CONSTANT BOTTOM AND SURFACE OBCS C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBW.GT.0)THEN DO M=1,NWQOBW @@ -993,16 +1134,18 @@ C CBW(M,1,NT)=WQOBCW(M,1,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBW(M),JWQCBW(M),(WQOBCW(M,1,NW),NW=1,NWQV) WRITE(2,97) IWQCBW(M),JWQCBW(M),(WQOBCW(M,1,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C *** C37 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBW.GT.0)THEN DO M=1,NWQOBW @@ -1014,8 +1157,10 @@ C *** C37 CBW(M,2,NT)=WQOBCW(M,2,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBW(M),JWQCBW(M),(WQOBCW(M,2,NW),NW=1,NWQV) WRITE(2,97) IWQCBW(M),JWQCBW(M),(WQOBCW(M,2,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C @@ -1023,13 +1168,13 @@ C *** C38 C EAST BDRY C READ(1,90) TITLE(M) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBE.GT.0)THEN DO M=1,NWQOBE @@ -1043,19 +1188,21 @@ C ELSE STOP ' WQ: EAST OBC: MISS MATCH BETWEEN NCBE & NWQOBE' ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBE(M),JWQCBE(M),(IWQOBE(M,NW),NW=1,NWQV) WRITE(2,969) IWQCBE(M),JWQCBE(M),(IWQOBE(M,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C C *** C39 C: CONSTANT BOTTOM AND SURFACE OBCS C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBE.GT.0)THEN DO M=1,NWQOBE @@ -1067,16 +1214,18 @@ C CBE(M,1,NT)=WQOBCE(M,1,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBE(M),JWQCBE(M),(WQOBCE(M,1,NW),NW=1,NWQV) WRITE(2,97) IWQCBE(M),JWQCBE(M),(WQOBCE(M,1,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) C *** C40 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBE.GT.0)THEN DO M=1,NWQOBE @@ -1088,8 +1237,10 @@ C *** C40 CBE(M,2,NT)=WQOBCE(M,2,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBE(M),JWQCBE(M),(WQOBCE(M,2,NW),NW=1,NWQV) WRITE(2,97) IWQCBE(M),JWQCBE(M),(WQOBCE(M,2,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C @@ -1097,13 +1248,13 @@ C *** C41 C NORTH BDRY C READ(1,90) TITLE(M) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBN.GT.0)THEN DO M=1,NWQOBN @@ -1117,19 +1268,21 @@ C ELSE STOP ' WQ: NORTH OBC: MISS MATCH BETWEEN NCBN & NWQOBN' ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBN(M),JWQCBN(M),(IWQOBN(M,NW),NW=1,NWQV) WRITE(2,969) IWQCBN(M),JWQCBN(M),(IWQOBN(M,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C C *** C42 C: CONSTANT BOTTOM AND SURFACE OBCS C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBN.GT.0)THEN DO M=1,NWQOBN @@ -1141,16 +1294,18 @@ C CBN(M,1,NT)=WQOBCN(M,1,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBN(M),JWQCBN(M),(WQOBCN(M,1,NW),NW=1,NWQV) WRITE(2,97) IWQCBN(M),JWQCBN(M),(WQOBCN(M,1,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) C *** C43 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) DO M=1,5 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO IF(NWQOBN.GT.0)THEN DO M=1,NWQOBN @@ -1162,8 +1317,10 @@ C *** C43 CBN(M,2,NT)=WQOBCN(M,2,NW) ENDDO ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQCBN(M),JWQCBN(M),(WQOBCN(M,2,NW),NW=1,NWQV) WRITE(2,97) IWQCBN(M),JWQCBN(M),(WQOBCN(M,2,NW),NW=1,NWQV) + ENDIF ENDDO ENDIF C @@ -1171,7 +1328,7 @@ C *** C44 C SPATIALLY/TEMPORALLY CONSTANT INITIAL CONDITIONS: WQCHLX=1/WQCHLX C READ DATA POINTS & DO INTERNAL INTERPOLATION? C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) @@ -1181,14 +1338,17 @@ C ENDDO ENDIF READ(1,*) (WQV(1,1,NW), NW=1,6) - WRITE(2,*) (WQV(1,1,NW), NW=1,6) READ(1,*) (WQV(1,1,NW), NW=7,13) - WRITE(2,*) (WQV(1,1,NW), NW=7,13) READ(1,*) (WQV(1,1,NW), NW=14,NWQV),WQV(1,1,IDNOTRVA),WQMCMIN + IF(MYRANK.EQ.0)THEN + WRITE(2,*) (WQV(1,1,NW), NW=1,6) + WRITE(2,*) (WQV(1,1,NW), NW=7,13) WRITE(2,*) (WQV(1,1,NW), NW=14,NWQV),WQV(1,1,IDNOTRVA),WQMCMIN + ENDIF IF(IWQICI.NE.1)THEN - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,21)' : (BC, BD, BG) = ', (WQV(1,1,NW),NW=1,3) WRITE(2,21)' : (RPOC, LPOC, DOC) = ', (WQV(1,1,NW),NW=4,6) WRITE(2,21)' : (RPOP,LPOP,DOP,PO4T) = ', (WQV(1,1,NW),NW=7,10) @@ -1197,6 +1357,7 @@ C WRITE(2,21)' : (SU, SA, COD, DO) = ', (WQV(1,1,NW),NW=16,19) WRITE(2,981)' : (TAM, FCB,MALG) = ', & (WQV(1,1,NW),NW=20,NWQV) + ENDIF WQCHL(1,1) = WQV(1,1,1)*WQCHLC + WQV(1,1,2)*WQCHLD & + WQV(1,1,3)*WQCHLG IF(IWQSRP.EQ.1)THEN @@ -1280,7 +1441,9 @@ C WQKMVD(L)=0.25 WQKMVE(L)=2.0 ENDDO + IF(MYRANK.EQ.0)THEN WRITE(2,9003) + ENDIF 9003 FORMAT(/,' MACALGMP.INP - MACROALGAE MAP FILE',/, & ' PSHADE = SHADE FACTOR FOR TREE CANOPY (1.0=NO CANOPY)',/, & ' KMV = MACROALGAE HALF-SATURATION VELOCITY (M/SEC)',/, @@ -1293,14 +1456,15 @@ C & ' KMVE = MACROALGAE VEL. LIMIT LOGISTIC FUNC. PARAM. E',/, & ' I J L PSHADE KMV KMVMIN KBP KMVA KMVB', & ' KMVC KMVD KMVE') - PRINT *,'WQ: MACALGMP.INP' + IF(MYRANK.EQ.0) PRINT *,'WQ: MACALGMP.INP' OPEN(3,FILE='MACALGMP.INP',STATUS='UNKNOWN') CALL SKIPCOMM(3, CCMRM) 9001 READ(3,*,END=9002) II, JJ, XMRM1, XMRM2, XMRM3, XMRM4, & XMRMA, XMRMB, XMRMC, XMRMD, XMRME IF(II .LE. 0) GOTO 9002 IF(IJCT(II,JJ).LT.1 .OR. IJCT(II,JJ).GT.8)THEN - PRINT*, 'I, J, IJCT(I,J) = ', II,JJ,IJCT(II,JJ) + IF(MYRANK.EQ.0) PRINT*, 'I, J, IJCT(I,J) = ' + & , II,JJ,IJCT(II,JJ) STOP 'ERROR!! INVALID (I,J) IN FILE MACALGMP.INP' ENDIF LL=LIJ(II,JJ) @@ -1316,9 +1480,11 @@ C WQKMVE(LL)=XMRME WQV(LL,1,IDNOTRVA)=WQV(1,1,IDNOTRVA) WQVO(LL,1,IDNOTRVA)=WQV(1,1,IDNOTRVA) + IF(MYRANK.EQ.0)THEN WRITE(2,9004) II, JJ, LL, PSHADE(LL), WQKMV(LL), WQKMVMIN(LL), & WQKBP(LL), WQKMVA(LL), WQKMVB(LL), WQKMVC(LL), WQKMVD(LL), & WQKMVE(LL) + ENDIF 9004 FORMAT(' ',I3,' ',I3,' ',I3, 9F7.3) GOTO 9001 9002 CLOSE(3) @@ -1328,7 +1494,7 @@ C C *** C45 C SPATIALLY/TEMPORALLY CONSTANT ALGAL GROWTH, RESPIRATION & PREDATION RA C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) @@ -1336,12 +1502,15 @@ C READ(1,*) WQPMC(1),WQPMD(1),WQPMG(1),WQPMM(1),WQBMRC(1), & WQBMRD(1),WQBMRG(1),WQBMRM(1),WQPRRC(1),WQPRRD(1), & WQPRRG(1),WQPRRM(1),WQKEB(1) + IF(MYRANK.EQ.0)THEN WRITE(2,*) WQPMC(1),WQPMD(1),WQPMG(1),WQPMM(1),WQBMRC(1), & WQBMRD(1),WQBMRG(1),WQBMRM(1),WQPRRC(1),WQPRRD(1), & WQPRRG(1),WQPRRM(1),WQKEB(1) + ENDIF IF(IWQAGR.NE.1)THEN - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* ALGAL GROWTH RATE (/DAY) ' WRITE(2,21)' : (PMC, PMD, PMG) = ', WQPMC(1),WQPMD(1), & WQPMG(1) @@ -1353,6 +1522,7 @@ C & WQPRRG(1) WRITE(2,82) & '* BASE LIGHT EXTINCTION COEFFICIENT (/M) = ',WQKEB(1) + ENDIF DO I=2,IWQZ WQPMC(I)=WQPMC(1) WQPMD(I)=WQPMD(1) @@ -1372,18 +1542,21 @@ C C C *** C46 SPATIALLY/TEMPORALLY CONSTANT SETTLING VELOCITIES AND REAERATION FACTO C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*)WQWSC(1),WQWSD(1),WQWSG(1),WQWSRP(1),WQWSLP(1),WQWSS(1), & WQWSM, REAC(1) + IF(MYRANK.EQ.0)THEN WRITE(2,*)WQWSC(1),WQWSD(1),WQWSG(1),WQWSRP(1),WQWSLP(1), & WQWSS(1),WQWSM, REAC(1) + ENDIF IF(IWQSTL.NE.1)THEN - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* ALGAL SETTLING RATE (M/DAY) ' WRITE(2,21)' : (WSC, WSD, WSG) = ', WQWSC(1),WQWSD(1), & WQWSG(1) @@ -1391,6 +1564,7 @@ C WRITE(2,21)' : (WSRP, WSLP) = ', WQWSRP(1),WQWSLP(1) WRITE(2,80)'* SETTLING RATE OF PARTICULATE METAL (M/DAY) ' WRITE(2,21)' : (WSS) = ', WQWSS(1) + ENDIF DO I=2,IWQZ WQWSC(I)=WQWSC(1) WQWSD(I)=WQWSD(1) @@ -1404,24 +1578,34 @@ C C C *** C47 SPATIALLY/TEMPORALLY CONSTANT BENTHIC FLUXES C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) -! If bentic flux for anoxic env some arrays have two dimensions - IF(IWQBEN .EQ. 0 .AND. IWQBENOX .NE. 0)THEN +!{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 +C READ(1,*) WQBFPO4D(1),WQBFNH4(1),WQBFNO3(1),WQBFSAD(1), !{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 +C & WQBFCOD(1),WQBFO2(1) +C WRITE(2,*) WQBFPO4D(1),WQBFNH4(1),WQBFNO3(1),WQBFSAD(1), +C & WQBFCOD(1),WQBFO2(1) + IF(IWQBEN.EQ.0.AND.IWQBENOX.NE.0)THEN MDUM=2 ELSE MDUM=1 ENDIF READ(1,*) (WQBFOXPO4D(1,M),WQBFOXNH4(1,M),WQBFOXNO3(1,M), & WQBFOXSAD(1,M),WQBFOXCOD(1,M),WQBFOXO2(1,M),M=1,MDUM) + IF(MYRANK.EQ.0)THEN WRITE(2,*) (WQBFOXPO4D(1,M),WQBFOXNH4(1,M),WQBFOXNO3(1,M), & WQBFOXSAD(1,M),WQBFOXCOD(1,M),WQBFOXO2(1,M),M=1,MDUM) IF(IWQBEN.EQ.0)THEN - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) +C WRITE(2,21)' : (PO4D, NH4, NO3) = ',WQBFPO4D(1),WQBFNH4(1), !{ GEOSR BENTHIC FLUX FOR ANOXIC ENV : YSSONG 2015.09.08 +C & WQBFNO3(1) +C WRITE(2,21)' : (SAD, COD, DO) = ',WQBFSAD(1),WQBFCOD(1), +C & WQBFO2(1) + IF(MYRANK.EQ.0)THEN WRITE(2,21)' : (PO4D, NH4, NO3) =',WQBFOXPO4D(1,1),WQBFOXNH4(1,1), & WQBFOXNO3(1,1) WRITE(2,21)' : (SAD, COD, DO) =',WQBFOXSAD(1,1),WQBFOXCOD(1,1), @@ -1431,6 +1615,8 @@ C & WQBFOXNH4(1,2),WQBFOXNO3(1,2) WRITE(2,21)' : (SAD, COD, DO) =',WQBFOXSAD(1,2), & WQBFOXCOD(1,2),WQBFOXO2(1,2) + ENDIF + ENDIF ENDIF DO L=2,LA WQBFPO4D(L)=WQBFOXPO4D(1,1) @@ -1447,31 +1633,35 @@ C C *** TEMPORALLY-CONSTANT VALUES FOR POINT SOURCE CONCENTRATIONS IN MG/L C *** EXCEPT XPSQ (M^3/S), TAM (KMOL/D), FCB (MPN/L). C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) C *** C48 IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) IWQPS,NPSTMSR + IF(MYRANK.EQ.0)THEN WRITE(2,*) IWQPS,NPSTMSR WRITE(2,23)'* NUMBER OF CELLS FOR POINT SOURCE INPUT = ',IWQPS WRITE(2,23)'* NUMBER WITH VARIABLE POINT SOURCE INPUT = ',NPSTMSR + ENDIF IF(IWQPS.GT.NWQPS) STOP 'ERROR!! IWQPS SHOULD BE <= NWQPS' DO M=1,3 READ(1,90) TITLE(M) - WRITE(2,90) TITLE(M) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(M) ENDDO DO M=1,IWQPS READ(1,*) I,J,K,ITMP,XPSQ,(XPSL(NW),NW=1,6) - WRITE(2,*) I,J,K,ITMP,XPSQ,(XPSL(NW),NW=1,6) READ(1,*) (XPSL(NW),NW=7,13) - WRITE(2,*) (XPSL(NW),NW=7,13) READ(1,*) (XPSL(NW),NW=14,NWQV) + IF(MYRANK.EQ.0)THEN + WRITE(2,*) I,J,K,ITMP,XPSQ,(XPSL(NW),NW=1,6) + WRITE(2,*) (XPSL(NW),NW=7,13) WRITE(2,*) (XPSL(NW),NW=14,NWQV) WRITE(2,294) I,J,K,ITMP,XPSQ,(XPSL(NW),NW=1,NWQV) + ENDIF IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN WRITE(*,911) I,J STOP 'ERROR!! INVALID (I,J) IN FILE WQ3DWC.INP FOR PSL' @@ -1553,21 +1743,24 @@ C C *** SPATIALLY/TEMPORALLY-CONSTANT VALUES FOR NON-POINT SOURCE INPUT C *** CONSTITUENT UNITS OF G/M2/DAY EXCEPT FCB WHICH IS MPN/M2/DAY. C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) DO M=1,3 READ(1,999) ENDDO READ(1,*) XDSQ,(XDSL(NW),NW=1,6) - WRITE(2,*) XDSQ,(XDSL(NW),NW=1,6) READ(1,*) (XDSL(NW),NW=7,13) - WRITE(2,*) (XDSL(NW),NW=7,13) READ(1,*) (XDSL(NW),NW=14,NWQV) + IF(MYRANK.EQ.0)THEN + WRITE(2,*) XDSQ,(XDSL(NW),NW=1,6) + WRITE(2,*) (XDSL(NW),NW=7,13) WRITE(2,*) (XDSL(NW),NW=14,NWQV) + ENDIF IF(IWQNPL.NE.1)THEN - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2, 21)' : (DSQ, CHC, CHD, CHG) = ',XDSQ,(XDSL(NW),NW=1,3) WRITE(2, 21)' : (ROC, LOC, DOC) = ',(XDSL(NW),NW=4,6) WRITE(2, 21)' : (ROP, LOP, DOP, P4D) = ',(XDSL(NW),NW=7,10) @@ -1575,9 +1768,9 @@ C WRITE(2, 21)' : (NHX, NOX) = ',(XDSL(NW),NW=14,15) WRITE(2, 21)' : (SUU, SAA, COD, DOX) = ',(XDSL(NW),NW=16,19) WRITE(2,981)' : (TAM, FCB) = ',(XDSL(NW),NW=20,NWQV) + ENDIF C PMC WQDSQ(1,1) = XDSQ C PMC DO NW=1,18 -C PMC WQWDSL(1,1,NW) = XDSL(NW) * CONV1 ! CONVERT FROM KG/DAY TO G/DAY C PMC ENDDO ! *** CONVERT FROM Kmol TO moles @@ -1604,18 +1797,21 @@ C *** C50 WET DEPOSTION (MULTIPLIED BY RAINFALL VOLUME IN RWQATM) C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) DO M=1,3 READ(1,999) ENDDO READ(1,*) (WQATM(NW),NW=1,6) - WRITE(2,*) (WQATM(NW),NW=1,6) READ(1,*) (WQATM(NW),NW=7,13) - WRITE(2,*) (WQATM(NW),NW=7,13) READ(1,*) (WQATM(NW),NW=14,NWQV) + IF(MYRANK.EQ.0)THEN + WRITE(2,*) (WQATM(NW),NW=1,6) + WRITE(2,*) (WQATM(NW),NW=7,13) WRITE(2,*) (WQATM(NW),NW=14,NWQV) - WRITE(2,999) - WRITE(2,90) TITLE(1) + ENDIF + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0)THEN WRITE(2, 21)' : (CHC, CHD, CHG) = ',(WQATM(NW),NW=1,3) WRITE(2, 21)' : (ROC, LOC, DOC) = ',(WQATM(NW),NW=4,6) WRITE(2, 21)' : (ROP, LOP, DOP, P4D) = ',(WQATM(NW),NW=7,10) @@ -1623,84 +1819,96 @@ C WRITE(2, 21)' : (NHX, NOX) = ',(WQATM(NW),NW=14,15) WRITE(2, 21)' : (SUU, SAA, COD, DOX) = ',(WQATM(NW),NW=16,19) WRITE(2,981)' : (TAM, FCB) = ',(WQATM(NW),NW=20,NWQV) + ENDIF C C *** C51 INPUT/OUTPUT FILE NAMES FOR SPATIALLY AND/OR TEMPORALLY VARYING PARAMETERS C *** MG/L FOR 1-19, TAM-MOLES/L, AND FCB-MPN/L IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,90) TITLE(1) - WRITE(2,999) - WRITE(2,90) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,90) TITLE(1) READ(1,295) RSTOFN - WRITE(2,85)'* OUTPUT FILE FOR RESTART (**NOT USED**) = ', RSTOFN READ(1,295) ICIFN + IF(MYRANK.EQ.0)THEN + WRITE(2,85)'* OUTPUT FILE FOR RESTART (**NOT USED**) = ', RSTOFN WRITE(2,85)'* FILE FOR INITIAL CONDITIONS = ', ICIFN + ENDIF IF(IWQICI.EQ.1)THEN - continue ELSE IF(IWQICI.EQ.2)THEN - continue ELSE IF(ICIFN(1:4).NE.'NONE'.AND.ICIFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQICI/ICIFN' ENDIF READ(1,295) AGRFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR ALGAL GROWTH, RESP., PREDATAT. = ', AGRFN + ENDIF IF(IWQAGR.EQ.1)THEN - continue ELSE IF(AGRFN(1:4).NE.'NONE'.AND.AGRFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQAGR/AGRFN' ENDIF READ(1,295) STLFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR SETTLING RATES OF ALGAE, PART. = ', STLFN + ENDIF IF(IWQSTL.EQ.1)THEN - continue ELSE IF(STLFN(1:4).NE.'NONE'.AND.STLFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQSTL/STLFN' ENDIF READ(1,295) SUNFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR IO, FD, TE, KT = ', SUNFN + ENDIF IF(IWQSUN.EQ.1)THEN - continue ELSE ! IF(SUNFN(1:4).NE.'NONE'.AND.SUNFN(1:4).NE.'none') !& STOP 'ERROR!! INVALID IWQSUN/SUNFN' ENDIF READ(1,295) BENFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR BENTHIC FLUX = ', BENFN + ENDIF IF(IWQBEN.EQ.2)THEN - continue ELSE IF(BENFN(1:4).NE.'NONE'.AND.BENFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQBEN/BENFN' ENDIF READ(1,295) PSLFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR POINT SOURCE INPUT = ', PSLFN + ENDIF READ(1,295) NPLFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* FILE FOR NPS INPUT INCLUDING ATM. INPUT = ', NPLFN + ENDIF IF(IWQNPL.EQ.1)THEN - continue ELSE IF(NPLFN(1:4).NE.'NONE'.AND.NPLFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQNPL/NPLFN' ENDIF READ(1,295) NCOFN + IF(MYRANK.EQ.0)THEN WRITE(2,85)'* DIAGNOSTIC FILE FOR NEGATIVE CONCENTRAT = ', NCOFN + ENDIF CLOSE(1) IF(IWQNC.EQ.1)THEN + IF(MYRANK.EQ.0)THEN OPEN(1,FILE=NCOFN,STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE=NCOFN,STATUS='UNKNOWN') WRITE(1,284)'* NEGATIVE CONCENTRATION OCCURS:' CLOSE(1) + ENDIF ELSE IF(NCOFN(1:4).NE.'NONE'.AND.NCOFN(1:4).NE.'none') & STOP 'ERROR!! INVALID IWQNC/NCOFN' @@ -1723,12 +1931,15 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) ! ! ! - PRINT *,'WQ: READING WQ3DWC2.INP - WATER QUALITY CONTROL FILE 2' +!{ GEOSR jgcho 2015.9.10 + IF(MYRANK.EQ.0) PRINT *,'WQ: READING WQ3DWC2.INP + & - WATER QUALITY CONTROL FILE 2' + IF(MYRANK.EQ.0)THEN write(2,*) write(2,*) write(2,*) write(2,'(a)') '===============Check WQ3DWC2.INP==============' -! + ENDIF ! OPEN(1,FILE='WQ3DWC2.INP',STATUS='UNKNOWN') ! @@ -1740,7 +1951,9 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) CCMRM = '#' IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,*) NXSP + IF(MYRANK.EQ.0)THEN WRITE(2,*) NXSP + ENDIF ! ! *** C02 WQ3DWC2.INP ! @@ -1748,7 +1961,9 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) IWQX(i) + IF(MYRANK.EQ.0)THEN WRITE(2,*) i,IWQX(i) + ENDIF enddo ! ! *** C03 WQ3DWC2.INP @@ -1757,12 +1972,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) WQKHNX(i),WQKHPX(i),WQKHSX(i),WQSTOXX(i) + IF(MYRANK.EQ.0)THEN WRITE(2,*) i,WQKHNX(i),WQKHPX(i),WQKHSX(i),WQSTOXX(i) - WRITE(2,80)'* HALF-SAT. CONSTANT (G/M^3) FOR NUTRIENT UPTAKE' + WRITE(2,80)'* HALF-SAT. COSNTANT (G/M^3) FOR NUTRIENT UPTAKE ' WRITE(2,81)' : (KHNX, KHPX) = ', WQKHNX(i),WQKHPX(i) WRITE(2,81)' : (KHS) = ', WQKHSX(i) WRITE(2,82)'* SAL. WHERE MICROSYSTIS GROWTH IS HALVED = ', & WQSTOXX(i) + ENDIF WQSTOXX(i) = WQSTOXX(i)*WQSTOXX(i) enddo ! @@ -1772,11 +1989,13 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) WQCHLX(i),WQDOPX(i) + IF(MYRANK.EQ.0)THEN WRITE(2,*) i,WQCHLX(i),WQDOPX(i) WRITE(2,80)'* CARBON-TO-CHL RATIO (G C PER MG CHL) ' WRITE(2,81)' : (CCHLX) = ', WQCHLX(i) WRITE(2,80)'* DEPTH (M) OF MAXIMUM ALGAL GROWTH ' WRITE(2,81)' : (DOPTX) = ', WQDOPX(i) + ENDIF WQCHLX(i)=1.0/(WQCHLX(i)+ 1.E-12) enddo ! @@ -1786,11 +2005,13 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQTMX1(i),WQTMX2(i),WQTMPX1(i),WQTMPX2(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQTMX1(i),WQTMX2(i),WQTMPX1(i),WQTMPX2(i) WRITE(2,80)'* LOWER OPTIMUM TEMP FOR ALGAL GROWTH (DEGC) ' WRITE(2,81)' : (TMX1 ) = ', WQTMX1(i) WRITE(2,80)'* UPPER OPTIMUM TEMP FOR ALGAL GROWTH (DEGC) ' WRITE(2,81)' : (TMX2 ) = ', WQTMX2(i) + ENDIF enddo ! ! *** C06 WQ3DWC2.INP @@ -1799,7 +2020,9 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQKGX1(i),WQKGX2(i),WQKGPX1(i),WQKGPX2(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQKGX1(i),WQKGX2(i),WQKGPX1(i),WQKGPX2(i) + ENDIF enddo ! ! *** C07 WQ3DWC2.INP @@ -1808,11 +2031,13 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQTRX(i),WQKTBX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQTRX(i),WQKTBX(i) WRITE(2,80)'* REFERENCE TEMPERATURE FOR ALGAL METABOLISM (OC)' WRITE(2,81)' : (TRX) = ', WQTRX(i) WRITE(2,80)'* TEMPERATURE EFFECT FOR ALGAL METABOLISM ' WRITE(2,81)' : (KTBX) = ', WQKTBX(i) + ENDIF enddo WQTDMIN=-10 ! changed from -10,BRW changed from -22 WQTDMAX=50 ! changed from 50, BRW changed from 38 @@ -1854,12 +2079,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQFCDX(i),WQKHRX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFCDX(i),WQKHRX(i) WRITE(2,80)'* CARBON DISTRIBUTION COEFF FOR ALGAL METABOLISM ' WRITE(2,81)' : (FCDX) = ', WQFCDX(i) WRITE(2,80) & '* HALF-SAT. CONSTANT (GO/M*3) FOR ALGAL DOC EXCRET' WRITE(2,81)' : (KHRX) = ', WQKHRX(i) + ENDIF CFCDWQX(i) = 1.0 - WQFCDX(i) enddo ! @@ -1869,6 +2096,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQFPRX(i),WQFPLX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFPRX(i),WQFPLX(i) WRITE(2,80) & '* PHOSPHORUS DIST COEF OF RPOP FOR ALGAL METABOLIS' @@ -1876,6 +2104,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) WRITE(2,80) & '* PHOSPHORUS DIST COEF OF LPOP FOR ALGAL METABOLIS' WRITE(2,81)' : (FPLX) = ', WQFPLX(i) + ENDIF enddo ! ! *** C10 WQ3DWC2.INP @@ -1884,6 +2113,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQFPDX(i),WQFPIX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFPDX(i),WQFPIX(i) WRITE(2,80) & '* PHOSPHORUS DIST COEF OF DOP FOR ALGAL METABOLISM' @@ -1891,14 +2121,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) WRITE(2,80) & '* PHOSPHORUS DIST COEF OF NH4 FOR ALGAL METABOLISM' WRITE(2,81)' : (FPIX) = ', WQFPIX(i) + ENDIF XPC = ABS(1.0 - (WQFPRX(i)+WQFPLX(i)+WQFPDX(i)+WQFPIX(i))) IF(XPC .GT. 0.0001)THEN - WRITE(2,*) - & '==================================================' - WRITE(2,*) i, - & ' WARNING! FPRX+FPLX+FPDX+FPIX NOT EQUAL TO 1.0' - WRITE(2,*) - & '==================================================' + IF(MYRANK.EQ.0)THEN + WRITE(2,*)'==================================================' + WRITE(2,*) i,' WARNING! FPRX+FPLX+FPDX+FPIX NOT EQUAL TO 1.0' + WRITE(2,*)'==================================================' + ENDIF ENDIF enddo ! @@ -1908,11 +2138,13 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQFNRX(i),WQFNLX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFNRX(i),WQFNLX(i) WRITE(2,80)'* NITROGEN DIST COEF OF RPON FOR ALGAL METABOLISM' WRITE(2,81)' : (FNRX) = ', WQFNRX(i) WRITE(2,80)'* NITROGEN DIST COEF OF LPON FOR ALGAL METABOLISM' WRITE(2,81)' : (FNLX) = ', WQFNLX(i) + ENDIF enddo ! ! *** C12 WQ3DWC2.INP @@ -1921,6 +2153,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*)WQFNDX(i),WQFNIX(i),WQANCX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFNDX(i),WQFNIX(i),WQANCX(i) WRITE(2,80)'* NITROGEN DIST COEF OF DON FOR ALGAL METABOLISM ' WRITE(2,81)' : (FNDX) = ', WQFNDX(i) @@ -1928,14 +2161,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) WRITE(2,81)' : (FNIX) = ', WQFNIX(i) WRITE(2,80)'* NITROGEN-TO-CARBON RATIO IN ALGAE ' WRITE(2,81)' : (ANCX) = ', WQANCX(i) + ENDIF XNC = ABS(1.0 - (WQFNRX(i)+WQFNLX(i)+WQFNDX(i)+WQFNIX(i))) IF(XNC .GT. 0.0001)THEN - WRITE(2,*) - & '==================================================' - WRITE(2,*) i, - & ' WARNING! FNRX+FNLX+FNDX+FNIX NOT EQUAL TO 1.0' - WRITE(2,*) - & '==================================================' + IF(MYRANK.EQ.0)THEN + WRITE(2,*)'==================================================' + WRITE(2,*) i,' WARNING! FNRX+FNLX+FNDX+FNIX NOT EQUAL TO 1.0' + WRITE(2,*)'==================================================' + ENDIF ENDIF enddo ! @@ -1946,6 +2179,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) do i=1,NXSP READ(1,*) WQFSPPX(i),WQFSIPX(i),WQFSPDX(i),WQFSIDX(i) & ,WQASCDX(i) + IF(MYRANK.EQ.0)THEN write(2,*)i,WQFSPPX(i),WQFSIPX(i),WQFSPDX(i),WQFSIDX(i) & ,WQASCDX(i) WRITE(2,80) @@ -1958,6 +2192,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) & WQFSIDX(i) WRITE(2,82)'*SILICA-TO-CARBON RATIO IN DIATOMS = ', & WQASCDX(i) + ENDIF enddo ! ! *** C14 WQ3DWC2.INP @@ -1966,6 +2201,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) WQPMX(1,i),WQBMRX(1,i),WQPRRX(1,i) + IF(MYRANK.EQ.0)THEN write(2,*) i,WQPMX(1,i),WQBMRX(1,i),WQPRRX(1,i) WRITE(2,80)'* ALGAL GROWTH RATE (/DAY) ' WRITE(2,21)' : (PMX) = ', WQPMX(1,i) @@ -1973,12 +2209,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) WRITE(2,21)' : (BMRX) = ', WQBMRX(1,i) WRITE(2,80)'* ALGAL PREDATION RATE (/DAY) ' WRITE(2,21)' : (PRRX) = ', WQPRRX(1,i) + ENDIF do ii=2,IWQZ WQPMX(ii,i)=WQPMX(1,i) WQBMRX(ii,i)=WQBMRX(1,i) WQPRRX(ii,i)=WQPRRX(1,i) enddo +! ENDIF enddo ! ! *** C15 WQ3DWC2.INP @@ -1987,10 +2225,14 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) WQWSX(1,i) + IF(MYRANK.EQ.0)THEN WRITE(2,*)i,WQWSX(1,i) + ENDIF IF(IWQSTL.NE.1)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,80)'* ALGAL SETTLING RATE (M/DAY) ' WRITE(2,21)' : (WSX) = ', WQWSX(1,i) + ENDIF DO ii=2,IWQZ WQWSX(ii,i)=WQWSX(1,i) ENDDO @@ -2001,11 +2243,16 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) ! IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,*) - read(1,*) m - write(2,*) 'IWQICIX=',m +!{ GEOSR X-species : jgcho 2015.10.01 + read(1,*) m ! GEOSR X-species : jgcho 2015.11.11 + IF(MYRANK.EQ.0)THEN + write(2,*) 'IWQICIX=',m ! GEOSR X-species : jgcho 2015.11.11 + ENDIF do i=1,NXSP READ(1,*) WQVX(1,1,i) + IF(MYRANK.EQ.0)THEN WRITE(2,*) i,WQVX(1,1,i) + ENDIF enddo if (m.ne.1) then DO K=1,KC @@ -2022,8 +2269,8 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) ENDDO else OPEN(714,FILE='WQWCRSTX.INP',STATUS='UNKNOWN') - WRITE(*,*) - & '* READING INITIAL CONDITIONS for Xspec. WQWCRSTX.INP' + IF(MYRANK.EQ.0) + & WRITE(*,*)'* READING INITIAL CONDITIONS for Xspec. WQWCRSTX.INP' read(714,*) read(714,*) DO M=1,(LA-1)*KC @@ -2046,8 +2293,10 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) do i=1,NXSP READ(1,*) ISSTOKEX(i),WQROH0X(i),WQRHOMNX(i),WQRHOMXX(i) & ,WQIRHALFX(i),WQCOEF1X(i),WQCOEF2X(i),WQCOEF3X(i) + IF(MYRANK.EQ.0)THEN WRITE(2,*) i,ISSTOKEX(i),WQROH0X(i),WQRHOMNX(i),WQRHOMXX(i) & ,WQIRHALFX(i),WQCOEF1X(i),WQCOEF2X(i),WQCOEF3X(i) + ENDIF WQCOEF1X(i)=WQCOEF1X(i)*(60.*24.) WQCOEF2X(i)=WQCOEF2X(i)*(60.*24.) WQCOEF3X(i)=WQCOEF3X(i)*(60.*24.) @@ -2056,13 +2305,17 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,*) READ(1,*) Light_Factor1, F_PAR + IF(MYRANK.EQ.0)THEN WRITE(2,*) Light_Factor1, F_PAR + ENDIF ! *** C18 WQ3DWC2.INP IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,*) do i=1,NXSP READ(1,*) WQRX(i),WQAX(i),WQRESISX(i) + IF(MYRANK.EQ.0)THEN write(2,*) i,WQRX(i),WQAX(i),WQRESISX(i) + ENDIF enddo ! *** C19 WQ3DWC2.INP IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) @@ -2070,33 +2323,46 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) READ(1,*) ISCYANO,NSZONE,CONCYA,TGERMI,KCG,DGTIME, & CYA_TEM,CYA_P4D,CYA_NO3,CYA_Light,Light_Factor2,NNAT + IF(MYRANK.EQ.0)THEN write(2,*) ISCYANO,NSZONE,CONCYA,TGERMI,KCG,DGTIME, & CYA_TEM,CYA_P4D,CYA_NO3,CYA_Light,Light_Factor2,NNAT + ENDIF ! *** C20 WQ3DWC2.INP IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,*) IF(ISCYANO.EQ.1) THEN DO I=1,NSZONE READ(1,*) NUM_ZONE(I), NUM_CELL(I) + IF(MYRANK.EQ.0)THEN write(2,*) NUM_ZONE(I), NUM_CELL(I) + ENDIF ENDDO ENDIF ! *** C21 WQ3DWC2.INP +! CALL SEEK('C21') IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) - IF(ISSKIP .EQ. 0) READ(1,*) - CALL SEEK('C21') + IF(ISSKIP .EQ. 0) READ(1,*) + IF(MYRANK.EQ.0)THEN + CALL SEEK('C21') write(2,*) 'C21' + ENDIF DO nsp=1,NXSP READ(1,*) NWQCSRX(nsp) + IF(MYRANK.EQ.0)THEN write(2,*) NWQCSRX(nsp) + ENDIF NT=4+NTOX+NSED+NSND+NWQV+nsp NCSER(NT)=NWQCSRX(nsp) ENDDO read(1,*) + IF(MYRANK.EQ.0)THEN write(2,*) + ENDIF DO M=1,IWQPS READ(1,*) I,J,K,ITMP + IF(MYRANK.EQ.0)THEN WRITE(2,*) I,J,K,ITMP + ENDIF DO nsp=1,NXSP N1=4+NTOX+NSED+NSND+NWQV+nsp NCSERQ(M,N1)=ITMP @@ -2172,8 +2438,11 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,*) READ(1,*) IWQBENOX,DOXCRT + IF(MYRANK.EQ.0)THEN write(2,*) IWQBENOX,DOXCRT write(2,*) + ENDIF + !} GEOSR X-species : jgcho 2015.09.17 close(1) ! ! @@ -2197,6 +2466,7 @@ C INITIALIZE IF(NXSP.ge.1)THEN IF(ISSTOKEX(1).EQ.1)THEN do i=1,IWQTS + IF(MYRANK.EQ.0)THEN WRITE(FLN,"('STOKE',I2.2,'.OUT')") i OPEN(1,FILE=trim(FLN)) ! VERTICAL VELOCITY, ALGAL-DENSITY, SOLAR RADIATION, chl-a PRINT AT EACH LAYER CLOSE(1,STATUS='DELETE') @@ -2214,6 +2484,7 @@ C INITIALIZE & ,(('sol_',nsp,'_',k,nsp=1,NXSP),k=KC,1,-1) & ,('chl_',k,k=KC,1,-1) CLOSE(1) + ENDIF enddo ENDIF ENDIF @@ -2256,6 +2527,52 @@ C INITIALIZE endif !} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 +!{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + if (IWQDGSTOX.eq.1) then + IF(MYRANK.EQ.0)THEN + PRINT *,'WQ: READING WQDGSTOX.INP - DG Salt TOX Control' + write(2,*) + write(2,*) + write(2,*) + write(2,'(a)') '===============Check WQDGSTOX.INP==============' + ENDIF + + OPEN(1,FILE='WQDGSTOX.INP',STATUS='OLD') +! *** C01 WQDGSTOX.INP + ISSKIP = 0 + READ(1,'(A1)') CCMRM + BACKSPACE(1) + IF(CCMRM .EQ. '#') ISSKIP = 1 + CCMRM = '#' + IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) + READ(1,*) WQCOEFSA(1),WQCOEFSB(1),WQSALA(1),WQSALB(1) + READ(1,*) WQCOEFSA(2),WQCOEFSB(2),WQSALA(2),WQSALB(2) + IF(MYRANK.EQ.0)THEN + WRITE(2,*) WQCOEFSA(1),WQCOEFSB(1),WQSALA(1),WQSALB(1) + WRITE(2,*) WQCOEFSA(2),WQCOEFSB(2),WQSALA(2),WQSALB(2) + ENDIF + + IF (NXSP.gt.0) then + allocate(WQCOEFSAX(NXSP)) + allocate(WQCOEFSBX(NXSP)) + allocate(WQSALAX(NXSP)) + allocate(WQSALBX(NXSP)) +! +! *** C02 WQDGSTOX.INP +! + IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) + IF(ISSKIP .EQ. 0) READ(1,*) + do i=1,NXSP + READ(1,*) WQCOEFSAX(i),WQCOEFSBX(i),WQSALAX(i),WQSALBX(i) + IF(MYRANK.EQ.0)THEN + WRITE(2,*) i,WQCOEFSAX(i),WQCOEFSBX(i),WQSALAX(i),WQSALBX(i) + ENDIF + enddo + ENDIF + CLOSE(1) + endif +!} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 + DO I=1,IWQZ IWQKA(I)=IWQKA(1) WQKRO(I)=WQKRO(1) @@ -2269,22 +2586,26 @@ C INITIALIZE WQKHCOD(I)=WQKHCOD(1) ENDDO IF(IWQZ .GT. 1 .AND. IWQKIN .GT. 0)THEN - PRINT *,'WQ: KINETICS.INP' + IF(MYRANK.EQ.0) PRINT *,'WQ: KINETICS.INP' OPEN(1,FILE='KINETICS.INP',STATUS='UNKNOWN') CALL SKIPCOMM(1,CCMRM) + IF(MYRANK.EQ.0)THEN WRITE(2,*) ' ' WRITE(2,*) ' SPATIALLY-VARYING KINETICS.INP FILE' WRITE(2,9111) + ENDIF DO I=1,IWQZ READ(1,*) IZ, IWQKA(IZ), WQKRO(IZ), WQKTR(IZ), REAC(IZ), & WQKDC(IZ),WQKDCALM(IZ),WQKHRM(IZ),WQDOPM(IZ),WQKCD(IZ), & WQKHCOD(IZ) + IF(MYRANK.EQ.0)THEN WRITE(2,*) IZ, IWQKA(IZ), WQKRO(IZ), WQKTR(IZ), REAC(IZ), & WQKDC(IZ),WQKDCALM(IZ),WQKHRM(IZ),WQDOPM(IZ),WQKCD(IZ), & WQKHCOD(IZ) WRITE(2,9112) IZ, IWQKA(IZ), WQKRO(IZ), WQKTR(IZ), REAC(IZ), & WQKDC(IZ),WQKDCALM(IZ),WQKHRM(IZ),WQDOPM(IZ),WQKCD(IZ), & WQKHCOD(IZ) + ENDIF ENDDO CLOSE(1) ENDIF @@ -2301,7 +2622,9 @@ C WTEMP =1.00*REAL(M-1)*0.1 - 14.95 DO I=1,IWQZ WQKCOD(M,I) = WQKCD(I) * EXP( WQKTCOD*(WTEMP-WQTRCOD) ) WQTDKR(M,I) = WQKTR(I)**TT20 + IF(MYRANK.EQ.0)THEN WRITE(2,2223)M,I,WQKTR(I),WQTDKR(M,I) + ENDIF ENDDO ENDDO C @@ -2314,31 +2637,39 @@ C ENDDO IF(IWQZ .GT. 1)THEN OPEN(1,FILE='WQWCMAP.INP',STATUS='UNKNOWN') - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) READ(1,30) (TITLE(M), M=1,3) + IF(MYRANK.EQ.0)THEN WRITE(2,30) (TITLE(M), M=1,3) + ENDIF C C READ(1,999) C READ(1,999) - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0)THEN WRITE(2,32) + ENDIF IN=0 IJKC=IC*JC*KC DO M=1,IJKC READ(1,*,END=1111) I,J,K,IWQZX IN=IN+1 IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN - PRINT*, 'I, J, K, IJCT(I,J) = ', I,J,K,IJCT(I,J) + IF(MYRANK.EQ.0) PRINT*, 'I, J, K, IJCT(I,J) = ', + & I,J,K,IJCT(I,J) STOP 'ERROR!! INVALID (I,J) IN FILE WQWCMAP.INP' ENDIF L = LIJ(I,J) IWQZMAP(L,K)=IWQZX + IF(MYRANK.EQ.0)THEN WRITE(2,31) L,I,J,K,IWQZMAP(L,K) + ENDIF ENDDO 1111 CONTINUE IF(IN.NE.(LA-1)*KC)THEN - PRINT*, 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' + IF(MYRANK.EQ.0) PRINT*, + & 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' STOP 'ERROR!! NUMBER OF LINES IN FILE WQWCMAP.INP =\ (LA-1)' ENDIF CLOSE(1) @@ -2358,10 +2689,12 @@ C ENDDO ENDDO OPEN(1,FILE='WQBENMAP.INP',STATUS='UNKNOWN') - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) DO M=1,4 READ(1,30) TITLE(M) + IF(MYRANK.EQ.0)THEN WRITE(2,30) TITLE(M) + ENDIF ENDDO C C SKIP ALL COMMENT CARDS AT BEGINNING OF FILE: @@ -2372,8 +2705,10 @@ C C C READ(1,999) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0)THEN WRITE(2,33) + ENDIF IN=0 IJKC=IC*JC DO M=1,IJKC @@ -2384,7 +2719,8 @@ C ENDIF IN=IN+1 IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN - PRINT*, 'I, J, K, IJCT(I,J) = ', I,J,IJCT(I,J) + IF(MYRANK.EQ.0) PRINT*, 'I, J, K, IJCT(I,J) = ', + & I,J,IJCT(I,J) STOP 'ERROR!! INVALID (I,J) IN FILE WQBENMAP.INP' ENDIF L = LIJ(I,J) @@ -2392,12 +2728,15 @@ C IBENMAP(L,2) = IZSAND IF(IWQBENOX.NE.0) IBENMAP(L,3) = IZANOX XBENMUD(L) = XMUD / 100.0 + IF(MYRANK.EQ.0)THEN WRITE(2,34) L, I, J, XBENMUD(L), IBENMAP(L,1), IBENMAP(L,2) + ENDIF ENDDO 1112 CONTINUE IF(IN .NE. (LA-1))THEN - PRINT*, 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' - STOP 'ERROR!! NUMBER OF LINES IN FILE WQBENMAP.INP <> (LA-1)' + IF(MYRANK.EQ.0) PRINT*, + & 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' + STOP 'ERROR1!! NUMBER OF LINES IN FILE WQBENMAP.INP <> (LA-1)' ENDIF CLOSE(1) ENDIF @@ -2410,10 +2749,12 @@ C ENDDO ENDDO OPEN(1,FILE='CYANOMAP.INP',STATUS='UNKNOWN') - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) DO M=1,4 READ(1,30) TITLE(M) + IF(MYRANK.EQ.0)THEN WRITE(2,30) TITLE(M) + ENDIF ENDDO C C SKIP ALL COMMENT CARDS AT BEGINNING OF FILE: @@ -2422,29 +2763,44 @@ C CCMRM = '#' CALL SKIPCOMM(1, CCMRM) C - WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0)THEN WRITE(2,33) + ENDIF IN=0 IJKC=IC*JC DO M=1,IJKC READ(1,*,END=1113) I, J, ICYAMUD IN=IN+1 IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN - PRINT*, 'I, J, K, IJCT(I,J) = ', I,J,IJCT(I,J) + IF(MYRANK.EQ.0) PRINT*, 'I, J, K, IJCT(I,J) = ', + & I,J,IJCT(I,J) STOP 'ERROR!! INVALID (I,J) IN FILE WQBENMAP.INP' ENDIF L = LIJ(I,J) ICYAMAP(L) = ICYAMUD + IF(MYRANK.EQ.0)THEN WRITE(2,34) L, I, J, ICYAMAP(L) + ENDIF ENDDO 1113 CONTINUE IF(IN .NE. (LA-1))THEN - PRINT*, 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' + IF(MYRANK.EQ.0) PRINT*, + & 'ALL ACTIVE WATER CELLS SHOULD BE MAPPED FOR WQ PAR.' STOP 'ERROR2!! NUMBER OF LINES IN FILE WQBENMAP.INP <> (LA-1)' ENDIF CLOSE(1) ENDIF - CLOSE(2) + +! IF(ISCYANO.EQ.1)THEN +! OPEN(1,FILE='CYANO.OUT') +! CLOSE(1,STATUS='DELETE') +! OPEN(1,FILE='CYANO.OUT') +! CLOSE(1) +! ENDIF +!} GeoSR Bentic-cyano : JHLEE 2015.10.12 + + IF(MYRANK.EQ.0) CLOSE(2) 2222 FORMAT(' M,WQKTR(1),WQTDKR(M,1) = ',I5,2F10.4) 2223 FORMAT(' M,I,WQKTR(1),WQTDKR(M,I) = ',2I5,2F10.4) 30 FORMAT(A79) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for index aa634ec14..3747fdc0a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQCSR.for @@ -3,7 +3,7 @@ C C CHANGE RECORD C USE GLOBAL - + USE MPI IMPLICIT NONE CHARACTER*11 FNWQSR(40) @@ -13,7 +13,9 @@ C CHARACTER*12 FNWQSRX(NXSP) ! X-species INTEGER*4 nsp ! Number of x-species. + IF(MYRANK.EQ.0)THEN PRINT *,'WQ: READING CWQSRxx.INP - WQ CONCENTRATION TIME SERIES' + ENDIF ! *** DEFINE THE INPUT FILE NAMES DO NW = 1,NWQV @@ -72,9 +74,9 @@ C STOP 901 CONTINUE if (NXSP.gt.0) then - ! Deal with x-species - PRINT *, - & 'WQ: READING CWQSRX##.INP, X WQ CONCENTRATION TIME SERIES' + IF(MYRANK.EQ.0)THEN + PRINT *,'WQ: READING CWQSRX##.INP, X WQ CONCENTRATION TIME SERIES' + ENDIF DO nsp=1,NXSP WRITE(SNUM,'(I2.2)')nsp FNWQSRX(nsp)='CWQSRX'//SNUM//'.INP' diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for index 71726f3fb..e758c1e0c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQICI.for @@ -4,6 +4,7 @@ C CHANGE RECORD C READ IN SPATIALLY AND/OR TEMPORALLY VARYING ICS (UNIT INWQICI). C USE GLOBAL + USE MPI CHARACTER TITLE(3)*79 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XWQV IF(.NOT.ALLOCATED(XWQV))THEN @@ -12,16 +13,18 @@ C ENDIF C OPEN(1,FILE=ICIFN,STATUS='UNKNOWN') + IF(MYRANK.EQ.0)THEN OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF - WRITE(2,60)'* READING INITIAL CONDITIONS' + IF(MYRANK.EQ.0)WRITE(2,60)'* READING INITIAL CONDITIONS' READ(1,50) (TITLE(M),M=1,3) - WRITE(2,999) - WRITE(2,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0)WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,50) (TITLE(M),M=1,3) READ(1,999) READ(1,50) TITLE(1) - WRITE(2,50) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,50) TITLE(1) DO M=2,LA READ(1,84) I,J,(XWQV(NW),NW=1,NWQV) IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8)THEN @@ -34,7 +37,7 @@ C WQV(L,K,NW)=XWQV(NW) ENDDO ENDDO - WRITE(2,84) I,J,(WQV(L,1,NW),NW=1,NWQV) + IF(MYRANK.EQ.0)WRITE(2,84) I,J,(WQV(L,1,NW),NW=1,NWQV) ENDDO C C: WQCHLX=1/WQCHLX @@ -61,7 +64,7 @@ C IWQICI = 0 CLOSE(1) - CLOSE(2) + IF(MYRANK.EQ.0) CLOSE(2) 999 FORMAT(1X) 50 FORMAT(A79) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for index 1571d0aea..c4711a3bd 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQPSL.for @@ -9,6 +9,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI DIMENSION RLDTMP(NTSWQVM) C IF(ITNWQ.GT.0) GOTO 1000 @@ -77,7 +78,7 @@ C ENDIF GOTO 901 900 CONTINUE - WRITE(6,601)NS,M + IF(MYRANK.EQ.0) WRITE(6,601)NS,M STOP 901 CONTINUE 1 FORMAT(120X) @@ -120,7 +121,7 @@ C ENDDO ENDDO C - IF(ITNWQ.EQ.0.AND.DEBUG)THEN + IF(ITNWQ.EQ.0.AND.DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='WQPSLT.DIA',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='WQPSLT.DIA',STATUS='UNKNOWN') @@ -136,7 +137,7 @@ C M.R. MORTON 02/20/1999 C MODIFIED SO MULTIPLE POINT SOURCES CAN BE ADDED TO ANY GRID CELL C AND ANY LAYER (HAD TO CHANGE WQWPSL ARRAY FROM 2D TO 3D). C - IF(ITNWQ.EQ.0)THEN + IF(ITNWQ.EQ.0.AND.MYRANK.EQ.0)THEN DO NW=1,NWQV DO K=1,KC DO L=2,LA @@ -175,7 +176,8 @@ C *** LOOP OVER THE WQ BOUNDARY CELLS L = LIJ(ICPSL(NS), JCPSL(NS)) K = KCPSL(NS) ITMP = MVPSL(NS) - IF(ITNWQ.EQ.0) WRITE(1,121)NS,L,ICPSL(NS),JCPSL(NS),K,ITMP + IF(ITNWQ.EQ.0.AND.MYRANK.EQ.0) + & WRITE(1,121)NS,L,ICPSL(NS),JCPSL(NS),K,ITMP IF(K.GE.1)THEN ! *** K>0, ASSIGN A SPECIFIC LAYER DO NW=1,NWQV @@ -194,7 +196,7 @@ C *** LOOP OVER THE WQ BOUNDARY CELLS ENDIF ENDDO - IF(ITNWQ.EQ.0)THEN + IF(ITNWQ.EQ.0.AND.MYRANK.EQ.0)THEN DO L=2,LA ITMP=IWQPSC(L,1) IF(ITMP.GT.0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for index 33a357eac..4387f28d1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQRST.for @@ -4,6 +4,7 @@ C CHANGE RECORD C READ ICS FROM RESTART FILE FROM INWQRST. C USE GLOBAL + USE MPI LOGICAL FEXIST C C CHECK FIRST TO SEE IF BINARY RESTART FILE EXISTS. IF NOT, USE @@ -12,7 +13,7 @@ C LK=(LA-1)*KC INQUIRE(FILE='WQWCRST.BIN', EXIST=FEXIST) IF(.NOT. FEXIST)THEN - PRINT *,'WQ: RESTART: WQWCRST.INP' + IF(MYRANK.EQ.0)PRINT *,'WQ: RESTART: WQWCRST.INP' OPEN(1,FILE='WQWCRST.INP',STATUS='UNKNOWN') READ(1,999) READ(1,999) @@ -23,12 +24,12 @@ C ENDDO CLOSE(1) ELSE - PRINT *,'WQ: RESTART: WQWCRST.BIN' + IF(MYRANK.EQ.0)PRINT *,'WQ: RESTART: WQWCRST.BIN' OPEN(UNIT=1, FILE='WQWCRST.BIN', & FORM='UNFORMATTED', STATUS='UNKNOWN') READ(1) NN_, XTIME XTIME=XTIME - WRITE(0,911) NN_, XTIME + IF(MYRANK.EQ.0)WRITE(0,911) NN_, XTIME 911 FORMAT(' READING BINARY WQWCRST.BIN FILE ... NN, TIME = ', & I7, F11.5) NWQV0=NWQV diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for index 66ba28244..28299ce40 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSTL.for @@ -17,44 +17,55 @@ C *** WQWSM = Settling velocity for macroalgae (m/day = 0.0) C *** WQWSM = Reaeration adjustment factor (NOT SAVED) C USE GLOBAL + USE MPI C CHARACTER TITLE(3)*79, STLCONT*3 C OPEN(7892,FILE=STLFN,STATUS='UNKNOWN') + IF(MYRANK.EQ.0) THEN OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF IF(STLDAY.EQ.0) THEN READ(7892,50) (TITLE(M),M=1,3) - WRITE(2,999) - WRITE(2,50) (TITLE(M),M=1,3) + IF(MYRANK.EQ.0) WRITE(2,999) + IF(MYRANK.EQ.0) WRITE(2,50) (TITLE(M),M=1,3) ENDIF - WRITE(2,60)'* SETTLING VELOCITY AT ', TIMTMP, +! WRITE(2,60)'* SETTLING VELOCITY AT ', IWQTSTL, ! GEOSR DAY read jgcho 2016.10.06 + IF(MYRANK.EQ.0) THEN + WRITE(2,60)'* SETTLING VELOCITY AT ', TIMTMP, ! GEOSR DAY read jgcho 2016.10.06 & ' TH DAY FROM MODEL START' + ENDIF READ(7892,999) READ(7892,50) TITLE(1) - WRITE(2,50) TITLE(1) + IF(MYRANK.EQ.0) WRITE(2,50) TITLE(1) IF(NXSP.EQ.0)THEN DO I=1,IWQZ READ(7892,*) MM,WQWSC(I),WQWSD(I),WQWSG(I),WQWSRP(I), & WQWSLP(I),WQWSS(I), WQWSM + IF(MYRANK.EQ.0) THEN WRITE(2,51) MM,WQWSC(I),WQWSD(I),WQWSG(I),WQWSRP(I),WQWSLP(I), & WQWSS(I), WQWSM + ENDIF ENDDO ELSE ! x-species require more variables to be exchanged DO I=1,IWQZ READ(7892,*) MM,WQWSC(I),WQWSD(I),WQWSG(I),WQWSRP(I), & WQWSLP(I),WQWSS(I), WQWSM,(WQWSX(I,NSP),NSP=1,NXSP) + IF(MYRANK.EQ.0) THEN WRITE(2,51) MM,WQWSC(I),WQWSD(I),WQWSG(I),WQWSRP(I),WQWSLP(I), & WQWSS(I), WQWSM,(WQWSX(I,NSP),NSP=1,NXSP) + ENDIF ENDDO ENDIF READ(7892,*) STLDAY, STLCONT + IF(MYRANK.EQ.0) WRITE(2,*) STLDAY, STLCONT WRITE(2,*) STLDAY, STLCONT IF(STLCONT.EQ.'END')THEN CLOSE(7892) IWQSTL = 0 ENDIF - CLOSE(2) + IF(MYRANK.EQ.0)CLOSE(2) 999 FORMAT(1X) 50 FORMAT(A79) 51 FORMAT(I3, 50F8.3) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSUN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSUN.for index 6ff82c8b7..cfa15f877 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSUN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQSUN.for @@ -10,11 +10,12 @@ C ** READS AND INTERPOLATES DAILY AVERAGE SOLAR RADIATION AND C ** DAYLIGHT FRACTION C USE GLOBAL + USE MPI IF(ITNWQ.GT.0) GOTO 1000 C C ** READ IN DAILY AVERAGE SOLAR SW RAD SERIES FROM FILE 'SUNDAY.INP' C - PRINT *,'WQ: SUNDAY.INP' + IF(MYRANK.EQ.0)PRINT *,'WQ: SUNDAY.INP' OPEN(1,FILE='SUNDAY.INP',STATUS='UNKNOWN') C C ** SKIP OVER TITLE AND AND HEADER LINES @@ -39,7 +40,7 @@ C CLOSE(1) GOTO 901 900 CONTINUE - WRITE(6,601)M + IF(MYRANK.EQ.0)WRITE(6,601)M STOP 901 CONTINUE 1 FORMAT(120X) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for index 5daa22131..c59bfcd92 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANASER.for @@ -1,8 +1,9 @@ SUBROUTINE SCANASER USE GLOBAL + USE MPI CHARACTER*120 LIN - WRITE(*,'(A)')'SCANNING INPUT FILE: ASER.INP' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'SCANNING INPUT FILE: ASER.INP' OPEN(1,FILE='ASER.INP',STATUS='OLD') DO N=1,NASER 10 READ(1,*,ERR=10,END=40)M,R,R,I,R,R,R,R @@ -16,7 +17,8 @@ IF(ISTRAN(8).GT.0)THEN IF(IWQSUN.EQ.1)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: SUNDAY.INP' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SCANNING INPUT FILE: SUNDAY.INP' OPEN(1,FILE='SUNDAY.INP',STATUS='UNKNOWN') M=0 DO I = 1,7 @@ -30,12 +32,14 @@ RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for index 59d7e011f..66ee2eb47 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANDSER.for @@ -1,7 +1,8 @@ SUBROUTINE SCANDSER(NCSER3) USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: DSER.INP' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'SCANNING INPUT FILE: DSER.INP' OPEN(1,FILE='DSER.INP',STATUS='OLD') DO NS=1,NCSER3 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R @@ -19,12 +20,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANEFDC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANEFDC.for index be03a7a2e..29a7452c6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANEFDC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANEFDC.for @@ -1,9 +1,10 @@ SUBROUTINE SCANEFDC(NCSER1,NCSER2,NCSER3,NCSER4) USE GLOBAL + USE MPI CHARACTER*3 NCARD - WRITE(*,'(A)')'SCANNING INPUT FILE: EFDC.INP' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'SCANNING INPUT FILE: EFDC.INP' OPEN(1,FILE='EFDC.INP',STATUS='OLD') CALL SEEK('C4') @@ -141,7 +142,9 @@ CALL SEEK('C40') READ(1,*,ERR=50)IWRSP(1) -50 WRITE(*,*)'NO COHESIVE SEDIMENT INFO IN INPUT FILE' +50 CONTINUE + IF(MYRANK.EQ.0) + & WRITE(*,*)'NO COHESIVE SEDIMENT INFO IN INPUT FILE' IF(NTOX.GT.0)THEN CALL SEEK('C45A') @@ -214,12 +217,14 @@ ENDIF RETURN - 10 WRITE(*,20) - WRITE(8,20) + 10 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,20) + IF(MYRANK.EQ.0) WRITE(8,20) 20 FORMAT('READ ERROR IN INPUT FILE') STOP - 30 WRITE(*,40) - WRITE(8,40) + 30 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,40) + IF(MYRANK.EQ.0) WRITE(8,40) 40 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for index 45a8b746e..84e699f0f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGATECTL.for @@ -2,8 +2,9 @@ ! SUBROUTINE SCANGATECTL USE GLOBAL + USE MPI - WRITE(*,'(A)')'SCANNING INPUT FILE: GATECTL.INP' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'SCANNING INPUT FILE: GATECTL.INP' OPEN(1,FILE='GATECTL.INP',STATUS='UNKNOWN') ! *** FINE MAXIMUM NUMBER OF GATE TYPES @@ -24,19 +25,22 @@ CLOSE(1) ! { GEOSR 2014.11.12 UNG Warning message writing + IF(MYRANK.EQ.0.AND.DEBUG)THEN OPEN(1,FILE='GateWarning.LOG',STATUS='UNKNOWN') ! GEOSR UNG 2014.11.12 Warning message writing CLOSE(1,STATUS='DELETE') ! GEOSR UNG 2014.11.12 Warning message writing OPEN(713,FILE='GateWarning.LOG',STATUS='UNKNOWN') ! GEOSR UNG 2014.11.12 Warning message writing WRITE(713,'(A)') & 'TIME N NCTL IQCTLU JQCTLU QSUM CellVOL' CLOSE(1) + ENDIF ! } GEOSR 2014.11.12 UNG Warning message writing RETURN C 10 FORMAT(A80) - 20 WRITE(*,30)'GATECTL.INP' - WRITE(8,30)'GATECTL.INP' + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30)'GATECTL.INP' + IF(MYRANK.EQ.0) WRITE(8,30)'GATECTL.INP' 30 FORMAT(' READ ERROR IN FILE: GATECTL.INP ') STOP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGSER.for index 1978a078e..4e5c3a883 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGSER.for @@ -2,10 +2,11 @@ ! SUBROUTINE SCANGSER USE GLOBAL + USE MPI CHARACTER*80 SKIP CHARACTER*11 INFILE - WRITE(*,'(A)')'SCANNING INPUT FILE: GATESER.INP' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'SCANNING INPUT FILE: GATESER.INP' INFILE='GATESER.INP' OPEN(1,FILE='GATESER.INP',STATUS='UNKNOWN') @@ -29,9 +30,10 @@ RETURN 10 FORMAT(A80) - 20 WRITE(*,30)INFILE - WRITE(8,30)INFILE + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30)INFILE + IF(MYRANK.EQ.0) WRITE(8,30)INFILE 30 FORMAT(' READ ERROR IN FILE: ',A10) STOP - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGTAB.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGTAB.for index 345f3d803..d9264a139 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGTAB.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGTAB.for @@ -2,11 +2,12 @@ ! SUBROUTINE SCANGTAB USE GLOBAL + USE MPI CHARACTER*11 INFILE INTEGER I,J INTEGER NOELE1,NOGELE1 - WRITE(*,'(A)')'SCANNING INPUT FILE: GATETAB.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: GATETAB.INP' INFILE='GATETAB.INP' OPEN(1,FILE='GATETAB.INP',STATUS='UNKNOWN') @@ -24,4 +25,4 @@ ENDDO CLOSE(1) RETURN - END SUBROUTINE \ No newline at end of file + END SUBROUTINE diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for index c3c1602e9..2c4268501 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANGWSR.for @@ -2,8 +2,9 @@ ! SUBROUTINE SCANGWSR USE GLOBAL + USE MPI, ONLY: MYRANK INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: GWSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: GWSER.INP' OPEN(1,FILE='GWSER.INP',STATUS='OLD') 10 READ(1,*,ERR=10,END=40)NGWSER NGWSERM=MAX(1,NGWSER) @@ -16,12 +17,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for index 873d1c9e9..8c23c0ee6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMASK.for @@ -1,7 +1,8 @@ SUBROUTINE SCANMASK USE GLOBAL + USE MPI - WRITE(*,'(A)')'SCANNING INPUT FILE: MASK.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: MASK.INP' OPEN(1,FILE='MASK.INP',STATUS='UNKNOWN') ! *** FINE MAXIMUM NUMBER OF MASK TYPE OVER 5 @@ -23,8 +24,9 @@ RETURN C 10 FORMAT(A80) - 20 WRITE(*,30)'MASK.INP' - WRITE(8,30)'MASK.INP' + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30)'MASK.INP' + IF(MYRANK.EQ.0) WRITE(8,30)'MASK.INP' 30 FORMAT(' READ ERROR IN FILE: GATECTL.INP ') STOP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for index af6580bf2..71258cea2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANMODC.for @@ -1,19 +1,22 @@ SUBROUTINE SCANMODC USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: MODCHAN.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: MODCHAN.INP' OPEN(1,FILE='MODCHAN.INP',STATUS='OLD') 10 READ(1,*,ERR=10,END=40)M,I,I NCHANM=MAX(1,M) READ(1,*,ERR=20,END=40)I,I,R CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for index 5dbcd60d8..00a138406 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANPSER.for @@ -1,7 +1,8 @@ SUBROUTINE SCANPSER USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: PSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: PSER.INP' OPEN(1,FILE='PSER.INP',STATUS='OLD') DO NS=1,NPSER 10 READ(1,*,ERR=10,END=40)M,R,R,R,R @@ -13,12 +14,14 @@ CLOSE(1) RETURN C - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQCTL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQCTL.for index 85845a0fe..4446368be 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQCTL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQCTL.for @@ -1,9 +1,10 @@ SUBROUTINE SCANQCTL USE GLOBAL + USE MPI CHARACTER*80 SKIP CHARACTER*10 INFILE - WRITE(*,'(A)')'SCANNING INPUT FILE: QCTL.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: QCTL.INP' INFILE='QCTL.INP' OPEN(1,FILE='QCTL.INP',STATUS='UNKNOWN') @@ -32,9 +33,10 @@ RETURN 10 FORMAT(A80) - 20 WRITE(*,30)INFILE - WRITE(8,30)INFILE + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30)INFILE + IF(MYRANK.EQ.0) WRITE(8,30)INFILE 30 FORMAT(' READ ERROR IN FILE: ',A10) STOP - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for index 0a89d5561..88750ef2e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANQSER.for @@ -1,8 +1,9 @@ SUBROUTINE SCANQSER USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: QSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: QSER.INP' OPEN(1,FILE='QSER.INP',STATUS='OLD') DO NS=1,NQSER @@ -22,12 +23,14 @@ CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END @@ -36,12 +39,14 @@ C ***************************************************************************** SUBROUTINE SCANQWSER USE GLOBAL + USE MPI INTEGER*4 NTMP, I, J, M, NV NTMP=4+NSED+NSND+NTOX ! *** Handle Water Quality variables, if needed IF(ISTRAN(8).GT.0)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP (PRELIM)' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP (PRELIM)' OPEN(1,FILE='WQ3DWC.INP',STATUS='OLD') CALL SEEK('C02') @@ -52,7 +57,7 @@ C ***************************************************************************** NTMP=NTMP+NWQV ENDIF - WRITE(*,'(A)')'SCANNING INPUT FILE: QWRS.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: QWRS.INP' OPEN(1,FILE='QWRS.INP',STATUS='OLD') DO NS=1,NQWRSR @@ -73,12 +78,14 @@ C ***************************************************************************** CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSEDZLJ.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSEDZLJ.f90 index 80cea3c88..3b49c56cf 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSEDZLJ.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSEDZLJ.f90 @@ -4,33 +4,34 @@ SUBROUTINE SCANSEDZLJ ! Craig Jones and Scott James !*************************************************************** USE GLOBAL + USE MPI IMPLICIT NONE INTEGER::IDUMMY,ERROR ! - WRITE(*,'(A)')'SCANNING INPUT FILE: BED.SDF' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: BED.SDF' OPEN(1,FILE='BED.SDF',STATUS='OLD') READ(1,*,IOSTAT=ERROR) !SKIP THIS LINE IF(ERROR==1)THEN - WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') - WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') STOP ENDIF READ(1,*,IOSTAT=ERROR) IDUMMY,IDUMMY,IDUMMY,KB IF(ERROR==1)THEN - WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') - WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') STOP ENDIF READ(1,*,IOSTAT=ERROR) !SKIP THIS LINE IF(ERROR==1)THEN - WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') - WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') STOP ENDIF READ(1,*,IOSTAT=ERROR) ITBM,NSICM IF(ERROR==1)THEN - WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') - WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(*,'("READ ERROR IN SEDZLJ INPUT FILE")') + IF(MYRANK.EQ.0)WRITE(8,'("READ ERROR IN SEDZLJ INPUT FILE")') STOP ENDIF CLOSE(1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for index 27cf071c7..012cb1cae 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSFSR.for @@ -1,7 +1,8 @@ SUBROUTINE SCANSFSR(NCSER4) USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: SFSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: SFSER.INP' OPEN(1,FILE='SFSER.INP',STATUS='OLD') DO NS=1,NCSER4 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R @@ -19,12 +20,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for index f31f47e4a..7d82f6a9d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANSSER.for @@ -1,7 +1,8 @@ SUBROUTINE SCANSSER(NCSER1) USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: SSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: SSER.INP' OPEN(1,FILE='SSER.INP',STATUS='OLD') DO NS=1,NCSER1 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R @@ -19,12 +20,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for index ea1260a1b..dc2021b08 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANTSER.for @@ -1,7 +1,8 @@ SUBROUTINE SCANTSER(NCSER2) USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: TSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: TSER.INP' OPEN(1,FILE='TSER.INP',STATUS='OLD') DO NS=1,NCSER2 10 READ(1,*,ERR=10,END=40)I,M,R,R,R,R @@ -19,12 +20,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for index 6291e507c..350101328 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWQ.for @@ -3,6 +3,7 @@ ! *** Merged SNL & DS-INTL Codes USE GLOBAL + USE MPI CHARACTER*10 INFILE CHARACTER*2 SNUM @@ -13,7 +14,7 @@ REAL*4 XPSQ LOGICAL fileExists - WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC.INP' INFILE='WQ3DWC.INP' OPEN(1,FILE='WQ3DWC.INP',STATUS='UNKNOWN') @@ -79,7 +80,7 @@ C ! *** SCAN THE TIME SERIES IF(NPSTMSR.GE.1.AND.IWQPSL.NE.2)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: WQPSL.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: WQPSL.INP' OPEN(1,FILE='WQPSL.INP',STATUS='UNKNOWN') DO IS=1,13 READ(1,1) @@ -135,7 +136,7 @@ C ! For x-species WQ3DWC2 needs to be checked INQUIRE(FILE='WQ3DWC2.INP',EXIST=fileExists) if (fileExists) then - WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC2.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: WQ3DWC2.INP' OPEN(1,FILE='WQ3DWC2.INP',STATUS='UNKNOWN') CALL SEEK('C01') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for index a8235f1ec..0f9c7e4a2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCANWSER.for @@ -1,7 +1,8 @@ SUBROUTINE SCANWSER USE GLOBAL + USE MPI INTEGER IOS - WRITE(*,'(A)')'SCANNING INPUT FILE: WSER.INP' + IF(MYRANK.EQ.0)WRITE(*,'(A)')'SCANNING INPUT FILE: WSER.INP' OPEN(1,FILE='WSER.INP',STATUS='OLD') DO NS=1,NWSER 10 READ(1,*,ERR=10,END=40)M,R,R,R,I @@ -12,12 +13,14 @@ ENDDO CLOSE(1) RETURN - 20 WRITE(*,30) - WRITE(8,30) + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30) + IF(MYRANK.EQ.0) WRITE(8,30) 30 FORMAT('READ ERROR IN INPUT FILE') STOP - 40 WRITE(*,50) - WRITE(8,50) + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50) + IF(MYRANK.EQ.0) WRITE(8,50) 50 FORMAT('UNEXPECTED END OF INPUT FILE') STOP END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCNTXSED.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCNTXSED.for index 7bf368759..1ad84c19d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCNTXSED.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SCNTXSED.for @@ -1,6 +1,7 @@ SUBROUTINE SCNTXSED USE GLOBAL + USE MPI CHARACTER*80 SKIP CHARACTER*10 INFILE @@ -10,7 +11,8 @@ IF(N.EQ.1)THEN NC=5 ! MSVTOX(1) IF(NTOX.GT.0.AND.NTOXSER.GT.0)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: TXSER.INP' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SCANNING INPUT FILE: TXSER.INP' INFILE='TXSER.INP' OPEN(1,FILE='TXSER.INP',STATUS='UNKNOWN') NLOOP=NTOX @@ -19,7 +21,8 @@ ELSEIF(N.EQ.2)THEN NC=NTOX+1 ! MSVSED(1) IF(NSED.GT.0.AND.NSEDSER.GT.0)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: SDSER.INP' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SCANNING INPUT FILE: SDSER.INP' INFILE='SDSER.INP' OPEN(1,FILE='SDSER.INP',STATUS='UNKNOWN') NLOOP=NSED @@ -28,7 +31,8 @@ ELSEIF(N.EQ.3)THEN NC=NTOX+NSED+1 ! MSVSND(1) IF(NSND.GT.0.AND.NSNDSER.GT.0)THEN - WRITE(*,'(A)')'SCANNING INPUT FILE: SNSER.INP' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SCANNING INPUT FILE: SNSER.INP' INFILE='SNSER.INP' OPEN(1,FILE='SNSER.INP',STATUS='UNKNOWN') NLOOP=NSND @@ -69,14 +73,16 @@ ENDDO RETURN - 20 WRITE(*,30)INFILE - WRITE(8,30)INFILE + 20 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,30)INFILE + IF(MYRANK.EQ.0) WRITE(8,30)INFILE 30 FORMAT(' READ ERROR IN FILE: ',A10) STOP - 40 WRITE(*,50)INFILE - WRITE(8,50)INFILE + 40 CONTINUE + IF(MYRANK.EQ.0) WRITE(*,50)INFILE + IF(MYRANK.EQ.0) WRITE(8,50)INFILE 50 FORMAT(' UNEXPECTED END OF FILE: ',A10) 60 FORMAT(A80) STOP - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SEEK.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SEEK.for index c7802e187..ff50d9456 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SEEK.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SEEK.for @@ -1,5 +1,6 @@ SUBROUTINE SEEK(TAG) C + USE MPI CHARACTER TAG*(*) CHARACTER*80 TEXT C @@ -10,11 +11,11 @@ C TAG(I:I)=CHAR(J-32) ENDIF ENDDO - WRITE(7,'(A,A)')'SEEKING GROUP: ',TAG + IF(MYRANK.EQ.0) WRITE(7,'(A,A)')'SEEKING GROUP: ',TAG DO K=1,2 10 READ(1,'(A)',END=20)TEXT M=MAX(1,LEN_TRIM(TEXT)) - WRITE(7,'(A)')TEXT(1:M) + IF(MYRANK.EQ.0) WRITE(7,'(A)')TEXT(1:M) DO WHILE(M.GT.L.AND.TEXT(1:1).EQ.'') TEXT(1:M-1)=TEXT(2:M) TEXT(M:M)=' ' diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 index d9d204618..8506e8266 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SHOWVAL.f90 @@ -3,6 +3,7 @@ SUBROUTINE SHOWVAL ! *** REWRITTEN BY PAUL M. CRAIG ON DEC 2006 USE GLOBAL + USE MPI CHARACTER BLANK,ASTER,CSURF(32),CSALS(20),CSALB(20) CHARACTER UNITS*3, PARM*3 SAVE INFODT, JSHPRT, UNITS, SCALE, PARM @@ -81,7 +82,8 @@ SUBROUTINE SHOWVAL ! *** ESTIMATE COMPUTATIONAL TIME IF(N.GT.1)THEN - CALL CPU_TIME(TCGRS) +! CALL CPU_TIME(TCGRS) + TCGRS=REAL(MPI_WTIMES(1)) T1=TBEGIN*TCON T2=(TBEGIN*TCON+TIDALP*NTC) TSPEED=TCGRS/(TIMESEC-T1) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for index bd7e91a4a..f1e2a5ebe 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SMRIN1.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI PARAMETER (SMCW2=2.739726E-5) ! *** cm/y to m/day CHARACTER TITLE(3)*79, CCMRM*1 @@ -28,9 +29,12 @@ C SMTHKP=0.0 ENDIF C - OPEN(2,FILE='WQ3D.OUT',STATUS='UNKNOWN',POSITION='APPEND') + IF(MYRANK.EQ.0) OPEN(2,FILE='WQ3D.OUT', + & STATUS='UNKNOWN',POSITION='APPEND') OPEN(1,FILE='WQ3DSD.INP',STATUS='UNKNOWN') + IF(MYRANK.EQ.0)THEN PRINT *,'WQ: SD READING WQ3DSD.INP - MAIN DIAGENESIS CONTROL FILE' + ENDIF C C READ FIRST LINE IN WQ3DSD.INP FILE. IF FIRST CHARACTER IS '#', THEN C THIS IS THE NEW VERSION WITH ANNOTATED COMMENTS ADDED (I.E., USES THE @@ -49,23 +53,26 @@ C01 READ MAIN TITLE CARDS: C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) (TITLE(M), M=1,3) - WRITE(2,999) - WRITE(2,5100) (TITLE(M), M=1,3) + IF(MYRANK.EQ.0)WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,5100) (TITLE(M), M=1,3) C C02 I/O CONTROL VARIABLES AND TEMPERATURE RELATED VARIABLES C - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) ISMZ,ISMICI,ISMRST,ISMHYST,ISMZB + IF(MYRANK.EQ.0)THEN WRITE(2,53)'* # OF ZONES FOR SPAT. VARY. PARAMETERS IN SPM =',ISMZ + ENDIF C *** PMC BEGIN BLOCK C IF(ISMZ.GT.NSMZ) STOP 'ERROR!! ISMZ SHOULD BE <= NSMZ' PMC NSMZ=ISMZ C *** PMC END BLOCK + IF(MYRANK.EQ.0)THEN IF(ISMICI.EQ.1)THEN WRITE(2,50)'* SPATIALLY/TEMPORALLY-VARYING ICS FROM WQSDICI.INP' ELSE IF(ISMICI.EQ.2)THEN @@ -93,6 +100,7 @@ C *** PMC END BLOCK ELSE WRITE(2,50)'* NO DIAGNOSTIC OUTPUT FOR FUNC ZBRENT ' ENDIF + ENDIF C C03 C @@ -100,9 +108,10 @@ C IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) ISMTS,TSMTSB,TSMTSE,SMTSDT, ISSDBIN IF(ISMTS.GT.NWQTS)THEN - WRITE(2,50)'** ISMTS SHOULD BE <= NWQTS ** ' + IF(MYRANK.EQ.0)WRITE(2,50)'** ISMTS SHOULD BE <= NWQTS ** ' ISMTS=NWQTS ENDIF + IF(MYRANK.EQ.0)THEN WRITE(2,84) & '* TIME-SERIES OUTPUT FROM ', TSMTSB, ' DAY ', & ' TO ', TSMTSE, ' DAY ', @@ -134,6 +143,7 @@ C & ' DFN3 DFP1 DFP2 DFP3', & ' DFC1 DFC2 DFC3') ENDIF + ENDIF C C ISSDBIN > 0 TURNS ON BINARY FILE OUTPUT FOR BENTHIC FLUX RATES C @@ -146,28 +156,31 @@ C04 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,50) TITLE(1) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) IF(ISMTS.GE.1)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,50)': ICSMTS(I)=1, TIME-SERIES OUTPUT FOR VARIABLE I' WRITE(2,50)': ICSMTS(I)\=1, NO TIME-SERIES OUTPUT FOR VAR. I' WRITE(2,999) WRITE(2,50) TITLE(1) + ENDIF C C04 C DO M=1,ISMTS READ(1,5101) II,JJ,(ICSMTS(NW,M),NW=1,NTSSMV) IF(IJCT(II,JJ).LT.1 .OR. IJCT(II,JJ).GT.8)THEN - PRINT*, 'I, J = ', II,JJ + IF(MYRANK.EQ.0)PRINT*, 'I, J = ', II,JJ STOP 'ERROR!! INVALID (I,J): TIME-SERIES LOCATION' ENDIF LSMTS(M)=LIJ(II,JJ) - WRITE(2,5101) II,JJ,(ICSMTS(NW,M),NW=1,NTSSMV) + IF(MYRANK.EQ.0)WRITE(2,5101) II,JJ,(ICSMTS(NW,M),NW=1,NTSSMV) ENDDO ENDIF ISMTSB = NINT(TSMTSB/DTD) ISMTSE = NINT(TSMTSE/DTD) ISMTSDT = NINT(SMTSDT*3600.0/DT) + IF(MYRANK.EQ.0)THEN WRITE(2,53)': TIME-SERIES STARTING TIME STEP (IN DT UNIT) = ', & ISMTSB WRITE(2,53)': TIME-SERIES ENDING TIME STEP (IN DT UNIT) = ', @@ -176,6 +189,7 @@ C & ISMTSDT C PMC IF(MOD(ISMTSDT,IWQDT).NE.0) C PMC & STOP 'ERROR!! ISMTSDT SHOULD BE MULTIPLE OF IWQDT' + ENDIF 999 FORMAT(1X) 5100 FORMAT(A79) 5101 FORMAT(10I8) @@ -192,31 +206,35 @@ C05 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) READ(1,5103) SMDIFT + IF(MYRANK.EQ.0)THEN WRITE(2,52)'* DIFF COEFF (M^2/S) FOR SED TEMPERATURE = ',SMDIFT + ENDIF SMDIFT = SMDIFT*8.64E4 ! *** Convert to m^2/day C C06 SPATIALLY CONSTANT PARAMETERS FOR SPLITING DEPOSITIONAL FLUXES OF AL C - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) C C07 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) READ(1,*) SMFNBC(1),SMFNBC(2),SMFNBC(3),SMFNBD(1),SMFNBD(2), & SMFNBD(3),SMFNBG(1),SMFNBG(2),SMFNBG(3) + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* CYANOBACTERIA-N SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FNBC1, FNBC2, FNBC3) = ', (SMFNBC(M),M=1,3) WRITE(2,50)'* DIATOMS-N SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FNBD1, FNBD2, FNBD3) = ', (SMFNBD(M),M=1,3) WRITE(2,50)'* BLUE-GREEN ALGAE-N SPLIT INTO G1, G2, G3 CLASSES' WRITE(2,51)' : (FNBG1, FNBG2, FNBG3) = ', (SMFNBG(M),M=1,3) + ENDIF SUMNBC=SMFNBC(1)+SMFNBC(2)+SMFNBC(3) SUMNBD=SMFNBD(1)+SMFNBD(2)+SMFNBD(3) SUMNBG=SMFNBG(1)+SMFNBG(2)+SMFNBG(3) @@ -231,15 +249,17 @@ C07 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) READ(1,*) SMFPBC(1),SMFPBC(2),SMFPBC(3),SMFPBD(1),SMFPBD(2), & SMFPBD(3),SMFPBG(1),SMFPBG(2),SMFPBG(3) + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* CYANOBACTERIA-P SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FPBC1, FPBC2, FPBC3) = ', (SMFPBC(M),M=1,3) WRITE(2,50)'* DIATOMS-P SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FPBD1, FPBD2, FPBD3) = ', (SMFPBD(M),M=1,3) WRITE(2,50)'* BLUE-GREEN ALGAE-P SPLIT INTO G1, G2, G3 CLASSES' WRITE(2,51)' : (FPBG1, FPBG2, FPBG3) = ', (SMFPBG(M),M=1,3) + ENDIF SUMPBC=SMFPBC(1)+SMFPBC(2)+SMFPBC(3) SUMPBD=SMFPBD(1)+SMFPBD(2)+SMFPBD(3) SUMPBG=SMFPBG(1)+SMFPBG(2)+SMFPBG(3) @@ -254,15 +274,17 @@ C08 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) READ(1,*) SMFCBC(1),SMFCBC(2),SMFCBC(3),SMFCBD(1),SMFCBD(2), & SMFCBD(3),SMFCBG(1),SMFCBG(2),SMFCBG(3) + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* CYANOBACTERIA-C SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FCBC1, FCBC2, FCBC3) = ', (SMFCBC(M),M=1,3) WRITE(2,50)'* DIATOMS-C SPLIT INTO G1, G2 & G3 CLASSES ' WRITE(2,51)' : (FCBD1, FCBD2, FCBD3) = ', (SMFCBD(M),M=1,3) WRITE(2,50)'* BLUE-GREEN ALGAE-C SPLIT INTO G1, G2, G3 CLASSES' WRITE(2,51)' : (FCBG1, FCBG2, FCBG3) = ', (SMFCBG(M),M=1,3) + ENDIF SUMCBC=SMFCBC(1)+SMFCBC(2)+SMFCBC(3) SUMCBD=SMFCBD(1)+SMFCBD(2)+SMFCBD(3) SUMCBG=SMFCBG(1)+SMFCBG(2)+SMFCBG(3) @@ -275,18 +297,20 @@ C C C09 SPATIALLY CONSTANT PARAMETERS FOR DIAGENESIS C - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMKPON(1),SMKPON(2),SMKPON(3),SMKPOP(1),SMKPOP(2), & SMKPOP(3),SMKPOC(1),SMKPOC(2),SMKPOC(3) + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* DIAGENESIS RATE AT 20OC IN LAYER 2 (/DAY) ' WRITE(2,51)' : (KPON1,KPON2,KPON3) = ', (SMKPON(M),M=1,3) WRITE(2,51)' : (KPOP1,KPOP2,KPOP3) = ', (SMKPOP(M),M=1,3) WRITE(2,51)' : (KPOC1,KPOC2,KPOC3) = ', (SMKPOC(M),M=1,3) + ENDIF C C10 C @@ -294,17 +318,19 @@ C IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMTHKN(1),SMTHKN(2),SMTHKN(3),SMTHKP(1),SMTHKP(2), & SMTHKP(3),SMTHKC(1),SMTHKC(2),SMTHKC(3) + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* TEMPERATURE EFFECT ON DIAGENESIS RATE ' WRITE(2,51)' : (THKN1,THKN2,THKN3) = ', (SMTHKN(M),M=1,3) WRITE(2,51)' : (THKP1,THKP2,THKP3) = ', (SMTHKP(M),M=1,3) WRITE(2,51)' : (THKC1,THKC2,THKC3) = ', (SMTHKC(M),M=1,3) WRITE(2,999) + ENDIF C C11 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMM1,SMM2,SMTHDD,SMTHDP,SMPOCR,SMKMDP,SMKBST, @@ -315,6 +341,7 @@ C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMO2BS,SMTDMBS,SMTCMBS + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* SOLID CONCENTRATIONS (KG/L) IN LAYERS 1 AND 2 ' WRITE(2,51)' : (RM1, RM2) = ', SMM1,SMM2 WRITE(2,50)'* TEMP EFFECT ON MIXING IN DISSOLVED & PARTICULATE' @@ -327,21 +354,23 @@ C & ,'* CRITICAL O2 (G/M^3) FOR BENTH. HYSTERESIS= ',SMO2BS & ,': TIME LAG (DAYS) FOR MAX STRESS TO BE KEPT= ',SMTDMBS & ,': TIME DURATION (D) ABOVE WHICH HYSTERESIS = ',SMTCMBS + ENDIF ISMTDMBS = NINT(SMTDMBS/DTWQ) ISMTCMBS = NINT(SMTCMBS/DTWQ) SM1OKMDP = 1.0/SMKMDP SMBST1 = 1.0 / (1.0 + SMKBST*DTWQ) - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) C C13 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMP1NH4,SMP2NH4,SMKMNH4,SMKMO2N,SMTHNH4,SMTHNO3, & SMP2PO4,SMCO2PO4 + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* PARTITION COEFF BET/ DISSOLVED AND SORBED NH4 ' WRITE(2,51)' : (P1NH4, P2NH4) = ', SMP1NH4,SMP2NH4 WRITE(2,50)'* HALF-SAT. CONST FOR NITRI. (GN/M^3, GO2/M^3) ' @@ -351,6 +380,7 @@ C WRITE(2,52)'* ANAEROBIC (LAY1) PARTITION COEF FOR PO4 (L/KG) = ' & ,SMP2PO4 & ,': CRITICAL DO (MG/L) FOR PO4 SORPTION = ',SMCO2PO4 + ENDIF SMFD1NH4 = 1.0 / (1.0 + SMM1*SMP1NH4) SMFP1NH4 = 1.0 - SMFD1NH4 SMFD2NH4 = 1.0 / (1.0 + SMM2*SMP2NH4) @@ -358,17 +388,18 @@ C SMKMO2N = SMKMO2N * 2.0 SMFD2PO4 = 1.0 / (1.0 + SMM2*SMP2PO4) SMFP2PO4 = 1.0 - SMFD2PO4 - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) C C14 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMP1H2S,SMP2H2S,SMKD1HS,SMKP1HS,SMTHH2S,SMKMH2S, & SMKCH4,SMTHCH4,SMCSHSCH + IF(MYRANK.EQ.0)THEN WRITE(2,50)'* PARTITION COEFF FOR H2S IN LAYER 1 (L/KG) ' WRITE(2,51)' : (P1H2S, P2H2S) = ', SMP1H2S,SMP2H2S WRITE(2,50)'* REACTION VEL (M/D) FOR DISSOL & PART. IN LAYER 1' @@ -379,6 +410,7 @@ C & ,': OXYGEN EFFECT (MG/L) ON H2S OXIDATION = ',SMKMH2S WRITE(2,52)'* METHANE OXIDATION REACTION VELOCITY (M/D)= ',SMKCH4 & ,': TEMPERATURE EFFECT ON CH4 OXIDATION RATE = ',SMTHCH4 + ENDIF SMFD1H2S = 1.0 / (1.0 + SMM1*SMP1H2S) SMFP1H2S = 1.0 - SMFD1H2S SMFD2H2S = 1.0 / (1.0 + SMM2*SMP2H2S) @@ -391,20 +423,23 @@ C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMO2C,SMO2NO3,SMO2NH4 + IF(MYRANK.EQ.0)THEN WRITE(2,52)'* STOICHI COEF FOR C USED BY H2S OX (GO2/GC)=',SMO2C & ,': STOICHI COEF FOR C USED BY DENITR (GO2/GN)=',SMO2NO3 & ,': STOICHI COEF FOR O2 USED BY NITRI (GO2/GN)=',SMO2NH4 WRITE(2,999) + ENDIF C C16 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) IF(ISSKIP .EQ. 0) READ(1,999) READ(1,*) SMKSI,SMTHSI,SMKMPSI,SMSISAT,SMP2SI,SMDP1SI,SMCO2SI, & SMJDSI + IF(MYRANK.EQ.0)THEN WRITE(2,52)'* PSI DISSOL. RATE AT 20C IN LAYER 2 (/D) = ',SMKSI & ,': TEMPERATURE EFFECT ON PSI DISSOLUTION = ',SMTHSI & ,': SAT. CONC. IN PORE WATER (G SI/M^3) = ',SMSISAT @@ -413,6 +448,7 @@ C & ,': CRITICAL DO (MG/L) FOR SI SORPTION = ',SMCO2SI & ,'* DETRITAL FLUX (G/M^2/D) EXCEPT DIATOMS = ',SMJDSI & ,'* DISSOLUTION HALF-SAT CONSTANT (G SI/M^3) = ',SMKMPSI + ENDIF SMFD2SI = 1.0 / (1.0 + SMM2*SMP2SI) SMFP2SI = 1.0 - SMFD2SI C @@ -446,29 +482,33 @@ C C C17 C - WRITE(2,998) + IF(MYRANK.EQ.0)WRITE(2,998) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) READ(1,*) SMPON(1,1),SMPON(1,2),SMPON(1,3),SMPOP(1,1), & SMPOP(1,2),SMPOP(1,3),SMPOC(1,1),SMPOC(1,2),SMPOC(1,3) + IF(MYRANK.EQ.0)THEN IF(ISMICI.NE.1 .AND. ISMICI.NE.2) & WRITE(2,5105) SMPON(1,1),SMPON(1,2),SMPON(1,3),SMPOP(1,1), & SMPOP(1,2),SMPOP(1,3),SMPOC(1,1),SMPOC(1,2),SMPOC(1,3) + ENDIF C C18 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) READ(1,*) SM1NH4(1),SM2NH4(1),SM2NO3(1),SM2PO4(1),SM2H2S(1), & SMPSI(1),SM2SI(1),SMBST(1),SMT(1) IF(ISMICI.NE.1 .AND. ISMICI.NE.2)THEN + IF(MYRANK.EQ.0)THEN WRITE(2,5105) SM1NH4(1),SM2NH4(1),SM2NO3(1),SM2PO4(1),SM2H2S(1), & SMPSI(1),SM2SI(1),SMBST(1),SMT(1) + ENDIF DO L=2,LA DO M=1,NSMG SMPON(L,M)=SMPON(1,M) @@ -489,18 +529,20 @@ C C C19 SMDIFT IN M^2/D C - WRITE(2,998) + IF(MYRANK.EQ.0)WRITE(2,998) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) DO I=1,ISMZ READ(1,*) MM,SMHSED(I),SMW2(I),SMDD(I),SMDP(I),SMKNH4(I), & SMK1NO3(I),SMK2NO3(I),SMDP1PO4(I), SODMULT(I) + IF(MYRANK.EQ.0)THEN WRITE(2,56) MM,SMHSED(I),SMW2(I),SMDD(I),SMDP(I),SMKNH4(I), & SMK1NO3(I),SMK2NO3(I),SMDP1PO4(I), SODMULT(I) + ENDIF SMW2(I) = SMW2(I)*SMCW2 ! *** M/Day SMDTOH(I) = DTWQ/SMHSED(I) SMHODT(I) = SMHSED(I)/DTWQ ! *** pmc - won't work for variable DT @@ -514,21 +556,23 @@ C SMW2PHODT(I) = SMW2(I) + SMHODT(I) SMDPMIN(I) = XSMDPMIN / (SMHSED(I)+ 1.E-18) ENDDO - WRITE(2,998) + IF(MYRANK.EQ.0)WRITE(2,998) C C20 C IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) READ(1,5100) TITLE(1) - WRITE(2,5100) TITLE(1) + IF(MYRANK.EQ.0)WRITE(2,5100) TITLE(1) DO I=1,ISMZ READ(1,*) MM,SMFNR(I,1),SMFNR(I,2),SMFNR(I,3),SMFPR(I,1), & SMFPR(I,2),SMFPR(I,3),SMFCR(I,1),SMFCR(I,2),SMFCR(I,3) + IF(MYRANK.EQ.0)THEN WRITE(2,54) MM,SMFNR(I,1),SMFNR(I,2),SMFNR(I,3),SMFPR(I,1), & SMFPR(I,2),SMFPR(I,3),SMFCR(I,1),SMFCR(I,2),SMFCR(I,3) + ENDIF SUMNBC=SMFNR(I,1)+SMFNR(I,2)+SMFNR(I,3) SUMNBD=SMFPR(I,1)+SMFPR(I,2)+SMFPR(I,3) SUMNBG=SMFCR(I,1)+SMFCR(I,2)+SMFCR(I,3) @@ -553,36 +597,38 @@ C ENDDO IF(ISMZ .GT. 1)THEN OPEN(1,FILE='WQSDMAP.INP',STATUS='UNKNOWN') - WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,999) READ(1,90) (TITLE(M), M=1,3) - WRITE(2,90) (TITLE(M), M=1,3) + IF(MYRANK.EQ.0)WRITE(2,90) (TITLE(M), M=1,3) C C READ(1,999) C READ(1,999) - WRITE(2,999) - WRITE(2,92) + IF(MYRANK.EQ.0)WRITE(2,999) + IF(MYRANK.EQ.0)WRITE(2,92) IN=0 IJC=IC*JC DO M=1,IJC READ(1,*,END=1111) I,J,ISMZX IN=IN+1 IF(IJCT(I,J).LT.1 .OR. IJCT(I,J).GT.8.OR.ISMZX.GT.ISMZ)THEN ! *** PMC - PRINT*, 'I, J, IJCT(I,J) = ', I,J,IJCT(I,J) + IF(MYRANK.EQ.0)PRINT*, 'I, J, IJCT(I,J) = ', I,J,IJCT(I,J) STOP 'ERROR!! INVALID (I,J) IN FILE WQSDMAP.INP' ENDIF L = LIJ(I,J) ISMZMAP(L)=ISMZX - WRITE(2,91) L,I,J,ISMZMAP(L) + IF(MYRANK.EQ.0)WRITE(2,91) L,I,J,ISMZMAP(L) ENDDO 1111 CONTINUE IF(IN.NE.(LA-1))THEN + IF(MYRANK.EQ.0)THEN PRINT*, 'ALL ACTIVE SED. CELLS SHOULD BE MAPPED FOR SED PAR.' + ENDIF STOP 'ERROR!! NUMBER OF LINES IN FILE WQSDMAP.INP =\ (LA-1)' ENDIF CLOSE(1) ENDIF - CLOSE(2) + IF(MYRANK.EQ.0) CLOSE(2) 90 FORMAT(A79) 91 FORMAT(15I5) 92 FORMAT(' L I J ISMZMAP') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for index e21360d48..11db6ddd6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SSEDTOX.for @@ -56,6 +56,7 @@ C ** SUBROUTINE SSEDTOX CALCULATES SETTLING AND WATER COLUMN-BED C ** EXCHANGE OF SEDIMENT AND SORBED TOXIC CONTAMINANTS C USE GLOBAL + USE MPI ! *** EE BEGIN BLOCK IMPLICIT NONE @@ -995,14 +996,18 @@ C DO L=2,LA IF(HP(L).LT.0.0)THEN IF(ABS(H1P(L)).GT.HWET)THEN + IF(MYRANK.EQ.0)THEN WRITE(8,2348)TIMEDAY,IL(L),JL(L),HBED1(L,KBT(L)), & HBED(L,KBT(L)),BELV1(L),BELV(L),DELT + ENDIF ENDIF IF(ABS(H1P(L)).GE.HADJ)THEN ! PMC-WAS HWET ITMP=1 + IF(MYRANK.EQ.0)THEN WRITE(8,2345)IL(L),JL(L),HBED1(L,KBT(L)),HBED(L,KBT(L)), & BELV1(L),BELV(L),DELT,QSBDTOP(L),QWBDTOP(L),HBEDA(L) WRITE(8,2347)L,KBT(L),(HBED(L,K),K=1,KBT(L)) + ENDIF ELSE HP(L)=0.9*HDRY ENDIF @@ -1010,7 +1015,7 @@ C ENDDO IF(ITMP.EQ.1)THEN CALL RESTOUT(1) - IF(NDRYSTP.LT.0.AND.DEBUG) THEN + IF(NDRYSTP.LT.0.AND.DEBUG.AND.MYRANK.EQ.0) THEN OPEN(1,FILE='DRYLOSS.OUT') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='DRYLOSS.OUT') diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for index 66bc6a4ae..e2b7aea7c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SUBCHAN.for @@ -6,6 +6,7 @@ C ** SUBROUTINE SUBCHAN CALCULATES SUBGRID CHANNEL INTERACTIONS AND IS C ** CALLED FROM CALPUV2TC C USE GLOBAL + USE MPI DIMENSION IACTIVE(NCHANM),QCHANUT(NCHANM),QCHANVT(NCHANM) REAL HCHNMX,HCHNMN HCHNMX=0.0 @@ -131,7 +132,7 @@ C FP(LCHNV)=FP(LCHNV)-TMPVAL ENDIF ENDDO - WRITE(8,1949)N,IACTALL + IF(MYRANK.EQ.0) WRITE(8,1949)N,IACTALL ENDIF 1949 FORMAT(' N, # ACTIVE 2 GRID FLOWS = ',2I8) C1948 FORMAT(I5,3E12.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SURFPLT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SURFPLT.for index fb9a09d09..f7e480859 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SURFPLT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/SURFPLT.for @@ -5,6 +5,7 @@ C ** SUBROUTINE SURFPLT WRITES FILES TO CONTOUR FREE SURFACE C ** ELEVATION C USE GLOBAL + USE MPI CHARACTER*80 TITLE C C *** EE BEGIN BLOCK @@ -13,6 +14,8 @@ C C C *** EE END BLOCK C + call collect_in_zero(HP) + IF(MYRANK.EQ.0)THEN IF(IPPHXY.LE.2)THEN IF(JSPPH.NE.1) GOTO 300 OPEN(10,FILE='SURFCON.OUT') @@ -119,7 +122,7 @@ C WRITE (10)N,TIME,DELT IF(IBIN_TYPE.EQ.1)THEN DO L=2,LA - WRITE(10) HP(L) + WRITE(10) HP(L) ENDDO ENDIF IF(IBIN_TYPE.EQ.0)THEN @@ -129,6 +132,7 @@ C CLOSE(10) ENDIF + ENDIF ! MYRANK.EQ.0 C C *** EE END BLOCK C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TMSR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TMSR.for index a0feda36e..bdfc549f8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TMSR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/TMSR.for @@ -7,6 +7,7 @@ C ** VELOCITY, CONCENTRATION, AND VOLUME SOURCES AT SPECIFIED C ** (I,J) POINTS C USE GLOBAL + USE MPI CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE4,TITLE5,TITLE6,TITLE7, & TITLE11,TITLE12,TITLE13,TITLE14,TITLE15,TITLE16,TITLE17, @@ -259,6 +260,7 @@ C IF(MTMSRC(MLTM).EQ.1)THEN IF(ISTRAN(1).GE.1)THEN FNSAL(MLTM)='SALTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(11,FILE=FNSAL(MLTM),STATUS='UNKNOWN') CLOSE(11,STATUS='DELETE') OPEN(11,FILE=FNSAL(MLTM),STATUS='UNKNOWN') @@ -268,8 +270,10 @@ C WRITE (11,102) CTUNIT CLOSE(11) ENDIF + ENDIF IF(ISTRAN(2).GE.1)THEN FNTEM(MLTM)='TEMTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(21,FILE=FNTEM(MLTM),STATUS='UNKNOWN') CLOSE(21,STATUS='DELETE') OPEN(21,FILE=FNTEM(MLTM),STATUS='UNKNOWN') @@ -279,8 +283,10 @@ C WRITE (21,102) CTUNIT CLOSE(21) ENDIF + ENDIF IF(ISTRAN(3).GE.1)THEN FNDYE(MLTM)='DYETS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(31,FILE=FNDYE(MLTM),STATUS='UNKNOWN') CLOSE(31,STATUS='DELETE') OPEN(31,FILE=FNDYE(MLTM),STATUS='UNKNOWN') @@ -290,8 +296,10 @@ C WRITE (31,102) CTUNIT CLOSE(31) ENDIF + ENDIF IF(ISTRAN(4).GE.1)THEN FNDYE(MLTM)='SFLTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(31,FILE=FNSFL(MLTM),STATUS='UNKNOWN') CLOSE(31,STATUS='DELETE') OPEN(31,FILE=FNSFL(MLTM),STATUS='UNKNOWN') @@ -301,8 +309,10 @@ C WRITE (31,102) CTUNIT CLOSE(31) ENDIF + ENDIF IF(ISTRAN(6).GE.1)THEN FNSED(MLTM)='SEDTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNSED(MLTM),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNSED(MLTM),STATUS='UNKNOWN') @@ -312,10 +322,12 @@ C WRITE (41,102) CTUNIT CLOSE(41) ENDIF + ENDIF IF(ISTRAN(7).GE.1)THEN DO NX=1,NSND FNSND(MLTM,NX)='SND'// CNSND(NX) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNSND(MLTM,NX),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNSND(MLTM,NX),STATUS='UNKNOWN') @@ -324,10 +336,12 @@ C WRITE (41,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (41,102) CTUNIT CLOSE(41) + ENDIF ENDDO DO NX=1,NSND FNSBL(MLTM,NX)='SBL'// CNSBL(NX) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNSBL(MLTM,NX),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNSBL(MLTM,NX),STATUS='UNKNOWN') @@ -336,19 +350,12 @@ C WRITE (41,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (41,102) CTUNIT CLOSE(41) + ENDIF ENDDO -C FNSND(MLTM)='SNDTS' // CNTMSR(MLTM) // '.OUT' -C OPEN(41,FILE=FNSND(MLTM),STATUS='UNKNOWN') -C CLOSE(41,STATUS='DELETE') -C OPEN(41,FILE=FNSND(MLTM),STATUS='UNKNOWN') -C WRITE (41,100) TITLE4 -C WRITE (41,101) CLTMSR(MLTM) -C WRITE (41,103)ILTMSR(MLTM),JLTMSR(MLTM) -C WRITE (41,102) CTUNIT -C CLOSE(41) ENDIF IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN FNBED(MLTM)='BEDTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNBED(MLTM),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNBED(MLTM),STATUS='UNKNOWN') @@ -358,8 +365,10 @@ C CLOSE(41) WRITE (41,102) CTUNIT CLOSE(41) ENDIF + ENDIF IF(ISTRAN(8).GE.1)THEN FNDOX(MLTM)='DOXTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNDOX(MLTM),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNDOX(MLTM),STATUS='UNKNOWN') @@ -368,7 +377,9 @@ C CLOSE(41) WRITE (41,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (41,102) CTUNIT CLOSE(41) + ENDIF FNTOC(MLTM)='TOCTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(42,FILE=FNTOC(MLTM),STATUS='UNKNOWN') CLOSE(42,STATUS='DELETE') OPEN(42,FILE=FNTOC(MLTM),STATUS='UNKNOWN') @@ -377,7 +388,9 @@ C CLOSE(41) WRITE (42,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (42,102) CTUNIT CLOSE(42) + ENDIF FNNHX(MLTM)='NHXTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(43,FILE=FNNHX(MLTM),STATUS='UNKNOWN') CLOSE(43,STATUS='DELETE') OPEN(43,FILE=FNNHX(MLTM),STATUS='UNKNOWN') @@ -387,10 +400,12 @@ C CLOSE(41) WRITE (43,102) CTUNIT CLOSE(43) ENDIF + ENDIF IF(ISTRAN(5).GE.1)THEN DO NT=1,NTOX FNTOX(MLTM,NT)='TOX' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTOX(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTOX(MLTM,NT),STATUS='UNKNOWN') @@ -399,8 +414,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXWT(MLTM,NT)='TXWT' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXWT(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXWT(MLTM,NT),STATUS='UNKNOWN') @@ -409,8 +426,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXWF(MLTM,NT)='TXWF' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXWF(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXWF(MLTM,NT),STATUS='UNKNOWN') @@ -419,8 +438,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXWC(MLTM,NT)='TXWC' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXWC(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXWC(MLTM,NT),STATUS='UNKNOWN') @@ -429,8 +450,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXWP(MLTM,NT)='TXWP' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXWP(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXWP(MLTM,NT),STATUS='UNKNOWN') @@ -439,8 +462,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXBT(MLTM,NT)='TXBT' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXBT(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXBT(MLTM,NT),STATUS='UNKNOWN') @@ -449,8 +474,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXBF(MLTM,NT)='TXBF' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXBF(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXBF(MLTM,NT),STATUS='UNKNOWN') @@ -459,8 +486,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXBC(MLTM,NT)='TXBC' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXBC(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXBC(MLTM,NT),STATUS='UNKNOWN') @@ -469,8 +498,10 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF FNTXBP(MLTM,NT)='TXBP' // CNTOX(NT) // 'TS' // & CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNTXBP(MLTM,NT),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNTXBP(MLTM,NT),STATUS='UNKNOWN') @@ -479,11 +510,13 @@ C CLOSE(41) WRITE (51,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (51,102) CTUNIT CLOSE(51) + ENDIF ENDDO ENDIF ENDIF IF(MTMSRA(MLTM).EQ.1)THEN FNAVV(MLTM)='AVVTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(61,FILE=FNAVV(MLTM),STATUS='UNKNOWN') CLOSE(61,STATUS='DELETE') OPEN(61,FILE=FNAVV(MLTM),STATUS='UNKNOWN') @@ -492,7 +525,9 @@ C CLOSE(41) WRITE (61,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (61,102) CTUNIT CLOSE(61) + ENDIF FNAVB(MLTM)='AVBTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(71,FILE=FNAVB(MLTM),STATUS='UNKNOWN') CLOSE(71,STATUS='DELETE') OPEN(71,FILE=FNAVB(MLTM),STATUS='UNKNOWN') @@ -502,8 +537,10 @@ C CLOSE(41) WRITE (71,102) CTUNIT CLOSE(71) ENDIF + ENDIF IF(MTMSRP(MLTM).EQ.1)THEN FNSEL(MLTM)='SELTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(11,FILE=FNSEL(MLTM),STATUS='UNKNOWN') CLOSE(11,STATUS='DELETE') OPEN(11,FILE=FNSEL(MLTM),STATUS='UNKNOWN') @@ -513,8 +550,10 @@ C CLOSE(41) WRITE (11,102) CTUNIT CLOSE(11) ENDIF + ENDIF IF(MTMSRUE(MLTM).EQ.1)THEN FNUVE(MLTM)='UVETS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(21,FILE=FNUVE(MLTM),STATUS='UNKNOWN') CLOSE(21,STATUS='DELETE') OPEN(21,FILE=FNUVE(MLTM),STATUS='UNKNOWN') @@ -524,8 +563,10 @@ C CLOSE(41) WRITE (21,102) CTUNIT CLOSE(21) ENDIF + ENDIF IF(MTMSRUT(MLTM).EQ.1)THEN FNUVT(MLTM)='UVTTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(31,FILE=FNUVT(MLTM),STATUS='UNKNOWN') CLOSE(31,STATUS='DELETE') OPEN(31,FILE=FNUVT(MLTM),STATUS='UNKNOWN') @@ -535,8 +576,10 @@ C CLOSE(41) WRITE (31,102) CTUNIT CLOSE(31) ENDIF + ENDIF IF(MTMSRU(MLTM).EQ.1)THEN FNU3D(MLTM)='U3DTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(41,FILE=FNU3D(MLTM),STATUS='UNKNOWN') CLOSE(41,STATUS='DELETE') OPEN(41,FILE=FNU3D(MLTM),STATUS='UNKNOWN') @@ -545,7 +588,9 @@ C CLOSE(41) WRITE (41,103)ILTMSR(MLTM),JLTMSR(MLTM) WRITE (41,102) CTUNIT CLOSE(41) + ENDIF FNV3D(MLTM)='V3DTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(51,FILE=FNV3D(MLTM),STATUS='UNKNOWN') CLOSE(51,STATUS='DELETE') OPEN(51,FILE=FNV3D(MLTM),STATUS='UNKNOWN') @@ -555,8 +600,10 @@ C CLOSE(41) WRITE (51,102) CTUNIT CLOSE(51) ENDIF + ENDIF IF(MTMSRQE(MLTM).EQ.1)THEN FNQQE(MLTM)='QQETS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(61,FILE=FNQQE(MLTM),STATUS='UNKNOWN') CLOSE(61,STATUS='DELETE') OPEN(61,FILE=FNQQE(MLTM),STATUS='UNKNOWN') @@ -566,8 +613,10 @@ C CLOSE(41) WRITE (61,102) CTUNIT CLOSE(61) ENDIF + ENDIF IF(MTMSRQ(MLTM).EQ.1)THEN FNQ3D(MLTM)='Q3DTS' // CNTMSR(MLTM) // '.OUT' + IF(MYRANK.EQ.0)THEN OPEN(71,FILE=FNQ3D(MLTM),STATUS='UNKNOWN') CLOSE(71,STATUS='DELETE') OPEN(71,FILE=FNQ3D(MLTM),STATUS='UNKNOWN') @@ -577,9 +626,11 @@ C CLOSE(41) WRITE (71,102) CTUNIT CLOSE(71) ENDIF + ENDIF ENDDO C JSTMSR=0 + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) C C----------------------------------------------------------------------C C @@ -642,6 +693,7 @@ C J=JLTMSR(MLTM) L=LIJ(I,J) LN=LNC(L) + IF(ISDOMAIN(L))THEN IF(MTMSRC(MLTM).EQ.1)THEN IF(ISTRAN(1).GE.1)THEN OPEN(11,FILE=FNSAL(MLTM),POSITION='APPEND') @@ -925,6 +977,7 @@ c IF(VHDXE(L).NE.0.0)CQBEDLOADY=QBEDLOADY/VHDXE(L) WRITE (71,201)TIME,(QSUM(L,K),K=1,KC) CLOSE(71) ENDIF + ENDIF ! ISDOMAIN(L) ENDIF ENDIF ENDDO diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for index a29de278e..06125d248 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VALKH.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI VALKH=0.0 IF(HFFDG.LE.0.02)THEN VALKH=HFFDG*HFFDG @@ -21,7 +22,7 @@ C RETURN ENDIF ENDDO - IF(NTAB.EQ.1001)THEN + IF(NTAB.EQ.1001.AND.MYRANK.EQ.0)THEN WRITE(6,600) RKHTAB(1001) WRITE(8,600) RKHTAB(1001) STOP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 index c03ea1f16..dbe830726 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 @@ -4,8 +4,9 @@ SUBROUTINE VARZEROInt ! *** USE GLOBAL + USE MPI ! - WRITE(*,'(A)')'ZEROING Integer ARRAYS' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'ZEROING Integer ARRAYS' ! ! *** INTEGER ARRAYS ! diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 index b0e8854f8..526880a85 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 @@ -4,8 +4,9 @@ SUBROUTINE VARZEROReal !C *** USE GLOBAL + USE MPI !C - WRITE(*,'(A)')'ZEROING REAL ARRAYS' + IF(MYRANK.EQ.0) WRITE(*,'(A)')'ZEROING REAL ARRAYS' !C !C *** REAL ARRAYS diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for index fbd6ae3f0..48c9104e0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WAVEBL.for @@ -3,6 +3,7 @@ C C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER*9 FNWAVE CHARACTER*1 CFNWAVE(0:9) C @@ -83,11 +84,13 @@ C WVFRQL(L)=2.*PI/WVFRQL(L) ENDDO CLOSE(1) + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='WAVEBL.DIA',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') + ENDIF NTMP=0 - WRITE(6,666)NTMP,FNWAVE - WRITE(8,666)NTMP,FNWAVE + IF(MYRANK.EQ.0) WRITE(6,666)NTMP,FNWAVE + IF(MYRANK.EQ.0) WRITE(8,666)NTMP,FNWAVE JSWAVE=1 ITWCBL1=1 ITWCBL2=0 @@ -145,8 +148,8 @@ C WVFRQL(L)=2.*PI/WVFRQL(L) ENDDO CLOSE(1) - WRITE(6,666)N,FNWAVE - WRITE(8,666)N,FNWAVE + IF(MYRANK.EQ.0) WRITE(6,666)N,FNWAVE + IF(MYRANK.EQ.0) WRITE(8,666)N,FNWAVE 666 FORMAT(' UPDATED WAVE FIELD N,FNWAVE = ',I12,A12) C C ** GENERATE WAVE TABLE @@ -179,7 +182,7 @@ C WVKHP(L)=1. IF(WVWHA(L).GT.0.) WVKHP(L)=VALKH(HFFDG) ENDDO - IF(JSWRPH.EQ.1)THEN + IF(JSWRPH.EQ.1.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='WVTAB.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='WVTAB.OUT',STATUS='UNKNOWN') @@ -221,9 +224,11 @@ C ** INITIALIZE WAVE-CURRENT BOUNDARY LAYER MODEL CALCULATING C ** THE WAVE TURBULENT INTENSITY, QQWV C ** AND SQUARED HORIZONTAL WAVE OBRITAL VELOCITY MAGNITUDE C + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='WAVEBL.DIA') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='WAVEBL.DIA') + ENDIF DO L=2,LA AEXTMP=0.5*WVWHA(L)/SINH(WVKHP(L)) UWORBIT=AEXTMP*WVFRQL(L) @@ -262,8 +267,10 @@ C ZBRE(L)=ZBR(L)*(1.+0.19*TMPVAL) ENDIF ENDIF + IF(MYRANK.EQ.0)THEN WRITE(1,600)L,IL(L),JL(L),WVWHA(L),WVFRQL(L),AEXTMP,UWORBIT, & VISMUDD,REYWAVE,CDTMP,QQWV1(L),QQWV2(L),ZBR(L),ZBRE(L) + ENDIF ENDDO CLOSE(1) 600 FORMAT(3I5,11E12.4) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for index 1c72a41af..17478bdc8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3DINP.for @@ -6,6 +6,7 @@ C OPTIMIZED AND MODIFIED BY J. M. HAMRICK C CHANGE RECORD C USE GLOBAL + USE MPI CHARACTER*3 CWQHDR(NWQVM) !{GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 CHARACTER*11 FLN1,FLN2 @@ -22,8 +23,12 @@ C PMC CHARACTER*11 HHMMSS IWQTPSL=IWQTPSL IWQTNPL=IWQTNPL ISMTICI=ISMTICI - OPEN(1,FILE='WQ3D.OUT',STATUS='UNKNOWN') - CLOSE(1,STATUS='DELETE') + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + IF(MYRANK.EQ.0)THEN + OPEN(8702,FILE='WQ3D.OUT',STATUS='UNKNOWN') + CLOSE(8702,STATUS='DELETE') + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) C C ** HARDWIRE BY PASS OF RATE COEFFICIENT MAPS C @@ -129,9 +134,12 @@ C C CALL RWQC2 C CALL RWQMAP C + IF(DEBUG)THEN + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='WQWCTS.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='WQWCTS.OUT',STATUS='UNKNOWN') + ENDIF NWQVOUT=0 DO NW=1,NWQV IF(ISTRWQ(NW).EQ.1)THEN @@ -139,18 +147,21 @@ C CWQHDR(NWQVOUT)=WQTSNAME(NW) ENDIF ENDDO - WRITE(1,1969)(CWQHDR(NW),NW=1,NWQVOUT) + IF(MYRANK.EQ.0) WRITE(1,1969)(CWQHDR(NW),NW=1,NWQVOUT) 1969 FORMAT('C I J K TIME',7X,A3,8X,A3,8X,A3, & 8X,A3,8X,A3,8X,A3,8X,A3,8X,A3,8X,A3, & 8X,A3,8X,A3,8X,A3,8X,A3,8X,A3,8X,A3, & 8X,A3,8X,A3,8X,A3,8X,A3,8X,A3,8X,A3) - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) + ENDIF C C ** INITIALIZE DIURNAL DO ANALYSIS C IF(NDDOAVG.GE.1.AND.DEBUG)THEN + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='DIURNDO.OUT') CLOSE(1,STATUS='DELETE') + ENDIF DO K=1,KC DO L=2,LA DDOMAX(L,K)=-1.E6 @@ -162,8 +173,10 @@ C C ** INITIALIZE LIGHT EXTINCTION ANALYSIS C IF(NDLTAVG.GE.1)THEN + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='LIGHT.OUT') CLOSE(1,STATUS='DELETE') + ENDIF NDLTCNT=0 DO K=1,KC DO L=2,LA diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for index 612372d90..f144cf9d0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE3.for @@ -10,6 +10,7 @@ C C LAST MODIFIED BY YSSONG ON 24 NOVEMBER 2011 USE GLOBAL + USE MPI C CHARACTER*11 FLN ! character array to print growth limit and algal rate INTEGER IZA ! Integer for benthic flux for anoxic env @@ -161,8 +162,8 @@ C IWQT(L) = NINT( 4.*TWQ(L)+121.) ELSE TIMTMP=TIMESEC/86400. ENDIF - WRITE(8,911) TIMTMP, L, IL(L), JL(L), K, TWQ(L) - WRITE(6,600)IL(L),JL(L),K,TWQ(L) + IF(MYRANK.EQ.0) WRITE(8,911) TIMTMP,L,IL(L),JL(L),K,TWQ(L) +c IF(MYRANK.EQ.0) WRITE(6,600)IL(L),JL(L),K,TWQ(L) IWQT(L)=MAX(IWQT(L),1) IWQT(L)=MIN(IWQT(L),NWQTD) C STOP 'ERROR!! INVALID WATER TEMPERATURE' @@ -2240,6 +2241,7 @@ C IF(ISCOMP .EQ. 3. OR. ISCOMP .EQ. 4)THEN TIME=DT*FLOAT(N)+TCON*TBEGIN TIME=TIME/TCON + IF(MYRANK.EQ.0)THEN WRITE(FLN,"('WQRTS',I2.2,'.DAT')") K OPEN(3,FILE=FLN,POSITION='APPEND') DO M=1,IWQTS @@ -2250,6 +2252,8 @@ C CLOSE(3) ENDIF ENDIF + ENDIF +!}GeoSR, GROWTH LIMIT AND ALGAL RATE PRINT, YSSONG, 2015.12.10 ENDDO C ---------------------------------------------------------------- C @@ -2357,7 +2361,7 @@ C C DIURNAL DO ANALYSIS C IF(NDDOAVG.GE.1)THEN - OPEN(1,FILE='DIURNDO.OUT',POSITION='APPEND') + IF(MYRANK.EQ.0) OPEN(1,FILE='DIURNDO.OUT',POSITION='APPEND') NDDOCNT=NDDOCNT+1 NSTPTMP=NDDOAVG*NTSPTC/2 RMULTMP=1./FLOAT(NSTPTMP) @@ -2375,11 +2379,13 @@ C ELSE TIME=TIMESEC/TCON ENDIF + IF(MYRANK.EQ.0)THEN WRITE(1,1111)N,TIME DO L=2,LA WRITE(1,1112)IL(L),JL(L),(DDOMIN(L,K),K=1,KC), & (DDOMAX(L,K),K=1,KC) ENDDO + ENDIF DO K=1,KC DO L=2,LA DDOMAX(L,K)=-1.E6 @@ -2387,13 +2393,13 @@ C ENDDO ENDDO ENDIF - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) ENDIF C C LIGHT EXTINCTION ANALYSIS C IF(NDLTAVG.GE.1)THEN - OPEN(1,FILE='LIGHT.OUT',POSITION='APPEND') + IF(MYRANK.EQ.0) OPEN(1,FILE='LIGHT.OUT',POSITION='APPEND') NDLTCNT=NDLTCNT+1 NSTPTMP=NDLTAVG*NTSPTC/2 RMULTMP=1./FLOAT(NSTPTMP) @@ -2423,11 +2429,13 @@ C RLIGHTC(L,K)=RMULTMP*RLIGHTC(L,K) ENDDO ENDDO + IF(MYRANK.EQ.0)THEN WRITE(1,1111)N,TIME DO L=2,LA WRITE(1,1113)IL(L),JL(L),(RLIGHTT(L,K),K=1,KC), & (RLIGHTC(L,K),K=1,KC) ENDDO + ENDIF DO K=1,KC DO L=2,LA RLIGHTT(L,K)=0. @@ -2435,7 +2443,7 @@ C ENDDO ENDDO ENDIF - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) ENDIF !{ GEOSR STOKES : YSSONG 2015.08.18 do nsp=1,NXSP @@ -2454,6 +2462,7 @@ C if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 IF(ISSTOKEX(1).EQ.1)THEN + IF(MYRANK.EQ.0)THEN do i=1,IWQTS WRITE(FLN,"('STOKE',I2.2,'.OUT')") i OPEN(1,FILE=trim(FLN),POSITION='APPEND') ! VERTICAL VELOCITY, ALGAL-DENSITY, SOLAR RADIATION, chl-a PRINT AT EACH LAYER @@ -2464,6 +2473,7 @@ C & ,(WQCHL(LWQTS(i),k),k=kc,1,-1) close(1) enddo + ENDIF ENDIF endif !if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 1114 FORMAT(F12.6,(E12.4)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for index 4249439b5..9a23fad76 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQSKE4.for @@ -125,16 +125,16 @@ C MRM +++++++++ ADDED BY M. MORTON 08/05/98 ELSE TIMTMP=TIMESEC/86400. ENDIF - WRITE(8,911) TIMTMP, L, IL(L), JL(L), K, TWQ(L) + IF(MYRANK.EQ.0) WRITE(8,911) TIMTMP,L,IL(L),JL(L),K,TWQ(L) C MRM +++++++++ ADDED BY M. MORTON 07/24/98 - WRITE(6,600)IL(L),JL(L),K,TWQ(L) +c IF(MYRANK.EQ.0) WRITE(6,600)IL(L),JL(L),K,TWQ(L) IWQT(L)=MAX(IWQT(L),1) IWQT(L)=MIN(IWQT(L),NWQTD) C STOP 'ERROR!! INVALID WATER TEMPERATURE' ENDIF ENDDO C - 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) +C 600 FORMAT(' I,J,K,TEM = ',3I5,E13.4) 911 FORMAT(/,'ERROR ', & 'TIME, L, I, J, K, TWQ(L) = ', F10.5, 4I4, F10.4) C @@ -1542,7 +1542,7 @@ C C DIURNAL DO ANALYSIS C IF(NDDOAVG.GE.1)THEN - OPEN(1,FILE='DIURNDO.OUT',POSITION='APPEND') + IF(MYRANK.EQ.0) OPEN(1,FILE='DIURNDO.OUT',POSITION='APPEND') NDDOCNT=NDDOCNT+1 NSTPTMP=NDDOAVG*NTSPTC/2 RMULTMP=1./FLOAT(NSTPTMP) @@ -1562,11 +1562,13 @@ C ELSE TIME=TIMESEC/TCON ENDIF + IF(MYRANK.EQ.0)THEN WRITE(1,1111)N,TIME DO L=2,LA WRITE(1,1112)IL(L),JL(L),(DDOMIN(L,K),K=1,KC), & (DDOMAX(L,K),K=1,KC) ENDDO + ENDIF DO K=1,KC DO L=2,LA DDOMAX(L,K)=-1.E6 @@ -1575,13 +1577,13 @@ C ENDDO ENDIF C - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) ENDIF C C LIGHT EXTINCTION ANALYSIS C IF(NDLTAVG.GE.1)THEN - OPEN(1,FILE='LIGHT.OUT',POSITION='APPEND') + IF(MYRANK.EQ.0) OPEN(1,FILE='LIGHT.OUT',POSITION='APPEND') NDLTCNT=NDLTCNT+1 NSTPTMP=NDLTAVG*NTSPTC/2 RMULTMP=1./FLOAT(NSTPTMP) @@ -1618,11 +1620,13 @@ C RLIGHTC(L,K)=RMULTMP*RLIGHTC(L,K) ENDDO ENDDO + IF(MYRANK.EQ.0)THEN WRITE(1,1111)N,TIME DO L=2,LA WRITE(1,1113)IL(L),JL(L),(RLIGHTT(L,K),K=1,KC), & (RLIGHTC(L,K),K=1,KC) ENDDO + ENDIF DO K=1,KC DO L=2,LA RLIGHTT(L,K)=0. @@ -1631,7 +1635,7 @@ C ENDDO ENDIF C - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) ENDIF C C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQRST.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQRST.for index 36aa9eceb..e4773a0a1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQRST.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQRST.for @@ -4,11 +4,21 @@ C CHANGE RECORD C WRITE SPATIAL DISTRIBUTIONS AT THE END OF SIMULATION TO UNIT IWQORST. C USE GLOBAL + USE MPI CHARACTER*64 RESTFN ! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 C C WRITE ASCII RESTART FILE: C + + DO NW=1,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + call collect_in_zero_array(QSUM) + IF(MYRANK.EQ.0)THEN IF (ISRST.EQ.0) THEN ! { GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 OPEN(1,FILE='WQWCRST.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') @@ -84,6 +94,7 @@ C ! } GEOSR X-species RESTART FILE EVERY REFERENCE TIME : JGCHO 2016.1.26 ! ENDIF ! IF (ISRST.EQ.0) THEN + ENDIF ! MYRANK.EQ.0 ! } GEOSR WRITE RESTART FILE EVERY REFERENCE TIME : JGCHO 2011.5.23 C C ALSO WRITE BINARY RESTART FILE: diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTS.for index b1ffd151a..5aa9a1e76 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTS.for @@ -5,6 +5,7 @@ C CHANGE RECORD C WRITE TIME-SERIES OUTPUT: WQCHLX=1/WQCHLX C USE GLOBAL + USE MPI C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::WQVOUT IF(.NOT.ALLOCATED(WQVOUT))THEN @@ -12,7 +13,9 @@ C WQVOUT=0.0 ENDIF C + IF(MYRANK.EQ.0.AND.DEBUG)THEN OPEN(1,FILE='WQWCTS.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF IF(ISDYNSTP.EQ.0)THEN TIMTMP=DT*FLOAT(N)+TCON*TBEGIN TIMTMP=TIMTMP/TCTMSR @@ -89,7 +92,8 @@ C WINDREA = WINDST(LL) WQVOUT(NWQOUT)=0.728*SQRT(WINDREA) & +(0.0372*WINDREA-0.317)*WINDREA - WRITE(1,71) IL(LL),JL(LL),K,TIMTMP, + IF(MYRANK.EQ.0.AND.DEBUG) WRITE(1,71) + & IL(LL),JL(LL),K,TIMTMP, & (WQVOUT(NWOUT),NWOUT=1,NWQOUT) ENDDO ENDDO @@ -102,7 +106,7 @@ C HHTMP = WATER DEPTH (METERS) C CHLM = MACROALGAE BIOMASS IN MICROGRAMS/SQUARE METER: C CHLM IN UG/L AS FOLLOWS: C - CLOSE(1) + IF(MYRANK.EQ.0) CLOSE(1) RETURN END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for index 9b5bb565a..90ee7aabb 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WWQTSBIN.for @@ -50,6 +50,7 @@ C WQVO(LL,K,10) = TOT. INORG. PHOS. WQVO(LL,K,21) = FECAL COLIFORM BACTERIA C WQVO(LL,K,11) = REFRACTORY PON WQVO(LL,K,22) = MACROALGAE C USE GLOBAL + USE MPI C LOGICAL ISASCII, IS2OPEN C @@ -379,7 +380,9 @@ C IF(NWQCNT .EQ. IWQTSDT)THEN TIMTMP = TIMESUM / NWQCNT C C OPEN WQ ASCII FILE: + IF(MYRANK.EQ.0.AND.DEBUG)THEN OPEN(1,FILE='WQWCTS.OUT',STATUS='UNKNOWN',POSITION='APPEND') + ENDIF C C OPEN WQ AVERAGE BINARY FILE: IF(ISWQAVG .GT. 0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for index b0162323c..15b930f91 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/foodchain.for @@ -22,6 +22,7 @@ C C**********************************************************************C C USE GLOBAL + USE MPI C ! *** DSLLC BEGIN INTEGER,ALLOCATABLE,DIMENSION(:)::KBFC @@ -159,7 +160,7 @@ C C C WRITE(8,*)' FIRST ENTRY TO FOODCHAIN.FOR ' C - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='FOODCHAIN.OUT') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='FOODCHAIN.OUT') @@ -486,7 +487,7 @@ C############################################################################### ENDIF ENDDO C - IF(JSFDCH.EQ.1.AND.DEBUG)THEN + IF(JSFDCH.EQ.1.AND.DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='FOODCHAIN.DIA') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='FOODCHAIN.DIA') @@ -664,7 +665,7 @@ C############################################################################### ENDDO ENDDO C - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='FOODCHAIN.OUT',POSITION='APPEND') C WRITE(1,101)TIME,NTOX,NFDCHZ,TIMFDCH diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin0.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin0.for index 252d5d612..a46c80c38 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin0.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin0.for @@ -27,6 +27,7 @@ C C------------------------------------------------------------------- C USE GLOBAL + USE MPI C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XLON REAL,SAVE,ALLOCATABLE,DIMENSION(:)::YLAT @@ -117,7 +118,7 @@ C--------------------------------------------------------- C C IF HYDTS.BIN ALREADY EXISTS, OPEN FOR APPENDING HERE. C - IF(ISTMSR .EQ. 2)THEN + IF(ISTMSR .EQ. 2.AND.MYRANK.EQ.0)THEN IO = 1 5 IO = IO+1 IF(IO .GT. 99)THEN @@ -144,7 +145,7 @@ C------------------------------------------------------------------- C C IF HYDTS.BIN ALREADY EXISTS, DELETE IT HERE. C - IF(ISTMSR .EQ. 1)THEN + IF(ISTMSR .EQ. 1.AND.MYRANK.EQ.0)THEN TBEGAN = TBEGIN IO = 1 10 IO = IO+1 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin2.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin2.for index 8188ad6e5..5e7bf2ee1 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/initbin2.for @@ -33,6 +33,7 @@ C**********************************************************************C C C USE GLOBAL + USE MPI C REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XLON REAL,SAVE,ALLOCATABLE,DIMENSION(:)::YLAT @@ -158,7 +159,7 @@ C--------------------------------------------------------- C C IF WQDIURDO.BIN ALREADY EXISTS, OPEN FOR APPENDING HERE. C - IF(ISDIURDO .EQ. 2)THEN + IF(ISDIURDO .EQ. 2.AND.MYRANK.EQ.0)THEN INQUIRE(FILE='WQDIURDO.BIN', EXIST=FEXIST) IF(FEXIST)THEN OPEN(UNIT=2, FILE='WQDIURDO.BIN', ACCESS='DIRECT', @@ -177,7 +178,7 @@ C------------------------------------------------------------------- C C IF WQDIURDO.BIN ALREADY EXISTS, DELETE IT HERE. C - IF(ISDIURDO .EQ. 1)THEN + IF(ISDIURDO .EQ. 1.AND.MYRANK.EQ.0)THEN TBEGAN = TBEGIN INQUIRE(FILE='WQDIURDO.BIN', EXIST=FEXIST) IF(FEXIST)THEN From d4a5587f835098b50406ba80f81523ac4f7a2711 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 5 Dec 2023 16:59:43 +0100 Subject: [PATCH 38/77] Extract OMP thread through OMP_GET_MAX_THREADS This makes the number of threads extracted consistent with the OpenDA wrapper's approach. --- .../native/efdc_fortran_dll/original_efdc_files/MPI.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 index a870092d5..c4112af8c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 @@ -43,8 +43,8 @@ SUBROUTINE MPI_INITIALIZE CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) !$OMP PARALLEL - OMPNUM=OMP_GET_NUM_THREADS() - CALL OMP_SET_NUM_THREADS(OMPNUM) + OMPNUM=OMP_GET_MAX_THREADS() + !CALL OMP_SET_NUM_THREADS(OMPNUM) !$OMP END PARALLEL CALL GETARG(2,MPI_DEBUG_C) From e7f5f7433b8cf718bd5029a242c5cd409ceaac83 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 5 Dec 2023 17:21:49 +0100 Subject: [PATCH 39/77] Add MPI init, finialise, and subroutine calls This propagates the MPI patches into the OpenDA wrapper. The MPI environment is initialised when the wrapper is set up. The domain decomposition seems required before the second model init, as is done in the EFDC.for main file. When the wrapper is destroyed, the MPI environment is destroyed as well. NOTE: This *ONLY* considers running with at most 1 rank and no care is taken to restrict certain operations to only the first rank, as would be needed for file IOa and/or log printing. --- .../openDA_wrapper/model_init.f90 | 4 ++- .../openDA_wrapper/model_init_2.for | 3 +- .../openDA_wrapper/model_init_3.for | 14 +++++---- .../openDA_wrapper/model_make_step.f90 | 4 +-- .../openDA_wrapper/model_state.f90 | 2 ++ .../openDA_wrapper/openDA_wrapper.F90 | 30 ++++++++++++------- 6 files changed, 38 insertions(+), 19 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 index 007ddcb0f..bf69eca9f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 @@ -8,13 +8,15 @@ subroutine model_init ! local CHARACTER(len=80) :: TITLE - call model_init_1 + call model_init_1 ! opens output files ! ** CALL INPUT SUBROUTINE CALL VARINIT CALL INPUT(TITLE) + CALL MPI_DECOMPOSITION + call model_init_2 ! ** READ RESTART CONDITIONS OR INITIALIZE SCALAR FIELDS diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_2.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_2.for index 66f6db109..4a56358a7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_2.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_2.for @@ -184,6 +184,7 @@ C ** DXDJ use omp_lib USE GLOBAL + USE MPI @@ -1009,7 +1010,7 @@ C C C ** SET BOUNDARY CONDITION SWITCHES C - CALL SETBCS + CALL SETBCS_mpi C C ** CALCUATE CURVATURE METRICS (NEW ADDITION) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for index 8a71cad5c..3588a225c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for @@ -1082,7 +1082,7 @@ C C ** SMOOTH INITIAL SALINITY C IF(NSBMAX.GE.1)THEN - CALL SALTSMTH + CALL SALTSMTH_mpi ENDIF C C ** OUTPUT INITIAL DEPTH AND SALINITY FIELDS @@ -1123,12 +1123,16 @@ C C C ** INITIALIZE EFDC EXPLORER OUTPUT C - IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT(1) + IF(IBIN_TYPE.EQ.1)THEN + IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT_mpi(1) + ELSEIF(IBIN_TYPE.EQ.0)THEN + IF(ISSPH(8).EQ.0.OR.ISBEXP.EQ.1) CALL EEXPOUT_opt_mpi(1) + ENDIF ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 C ** INITIALIZE EFDC HYDRO DISTRIBUTION OUTPUT - IF(ISRESTO.LT.-20)THEN - CALL RESTOUT(-20) - ENDIF +! IF(ISRESTO.LT.-20)THEN +! CALL RESTOUT(-20) +! ENDIF ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 END SUBROUTINE model_init_3 diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 index c95ab1b9a..1ff8e1e18 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 @@ -15,10 +15,10 @@ subroutine model_make_step(time_period) NITERAT=0 IF(IS2TIM.EQ.0) then write(*,'(A,F8.4,A,F6.1,A)') "time integration with HDMT from day ", TBEGIN, ' over ', time_period / 60.0, ' minutes' - CALL HDMT + CALL HDMT_mpi elseif (IS2TIM.GE.1) then write(*,'(A,F8.4,A,F6.1,A)') "time integration with HDMT2T from day ", TBEGIN, ' over ', time_period / 60.0, ' minutes' - CALL HDMT2T + CALL HDMT2T_mpi end if end subroutine model_make_step diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 index 9a9f02fdf..4ee7a2def 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 @@ -552,6 +552,8 @@ function model_set_state(id) result(ret_val) call INPUT(TITLE) + call MPI_DECOMPOSITION + call model_init_2 ! Act like this is a restart diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 index cd48f1505..41997e392 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 @@ -102,6 +102,7 @@ function m_openda_wrapper_init_(parent_directory_c, template_directory_c)& #endif use omp_lib + use mpi USE GLOBAL, only: TBEGIN, TCON, TIDALP, NTC, TIMEDAY, & NDASER, NASERM, NDPSER, NPSERM, NDQSER, NQSERM,NDCSER, NCSERM, & NTOX, NSED, NSND, NWQV, NTHDS, NDQCLT, NQCTLM, & @@ -113,7 +114,7 @@ function m_openda_wrapper_init_(parent_directory_c, template_directory_c)& ! return value integer(kind=c_int) :: ret_val ! ret_val < 0: Error; ret_val == 0 success - + !locals character(len=max_path_length) :: output_file_name, message_file_name character(len=max_path_length) :: cwd @@ -123,39 +124,45 @@ function m_openda_wrapper_init_(parent_directory_c, template_directory_c)& integer :: i_number integer :: i logical :: i_open - + + ! initialise MPI environments + ! + ! NOTE: This only supports runs with maximum of 1 rank and no care has been + ! taken to isolate print statements to run only on the first rank. + call mpi_initialize + ! body ret_val = -1 ret_val = c_to_f_string(parent_directory_c, parent_directory) - if (ret_val /= 0) then + if (ret_val /= 0) then print*, "ERROR: maximum path length exceeded for ", parent_directory return end if ret_val = c_to_f_string(template_directory_c, template_directory) - if (ret_val /= 0) then + if (ret_val /= 0) then print*, "ERROR: maximum path length exceeded for ", template_directory return end if - + dm_model_parent_dir = trim(parent_directory) dm_template_model_dir = trim(template_directory) print*, trim(dm_model_parent_dir) output_file_name = trim(dm_model_parent_dir) // '/model.log' message_file_name = trim(dm_model_parent_dir) // '/messages.log' - + ! create new model.log - inquire(file = output_file_name, opened=i_open, number=i_number) + inquire(file = output_file_name, opened=i_open, number=i_number) if (i_open .and. (i_number == dm_general_log_handle)) close(i_number) open(dm_general_log_handle, file=output_file_name, status = 'replace') write(dm_general_log_handle,'(A)') 'EFDC initialized' ! create new messages.log - inquire(file = message_file_name, opened=i_open, number=i_number) + inquire(file = message_file_name, opened=i_open, number=i_number) if (i_open .and. (i_number == message_file_handle)) close(i_number) open(message_file_handle, file=message_file_name, status = 'replace') - + message = "Starting EFDC run" call write_message(message, M_INFO) @@ -250,7 +257,8 @@ subroutine m_openda_wrapper_destroy_()& write(dm_general_log_handle,'(A)') 'EFDC destroy()' close(dm_general_log_handle) close(message_file_handle) - + + call mpi_finalize(ret_val) end subroutine m_openda_wrapper_destroy_ ! -------------------------------------------------------------------------- @@ -506,6 +514,7 @@ function m_openda_wrapper_select_instance_from_restart_files_(instance) & #endif use global, only : ISTRAN, IWQRST, IWQBEN, ISMRST, ISRESTI, TIMESEC, TIMEDAY, TBEGIN, IWQAGR, HP + use mpi ! return value @@ -530,6 +539,7 @@ function m_openda_wrapper_select_instance_from_restart_files_(instance) & call INPUT(TITLE) ! Act like this is a restart + call MPI_DECOMPOSITION ISRESTI = 1 call model_init_2 From d4fa9fa235bbb9b7ab10f8a0043c39b2782ab994 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 12 Dec 2023 11:01:41 +0100 Subject: [PATCH 40/77] VFPROJ wip: repairs the visual studio project??? --- .../native/efdc_fortran_dll/EfdcFortranDLL.vfproj | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index 82c740f42..cd2c5cc2c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -397,5 +397,7 @@ - - + + + + From d638fc1c4b1e0158b1d6eb74c3abfc84df4c2be9 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 12 Dec 2023 11:05:56 +0100 Subject: [PATCH 41/77] VFPROJ project file after first build attempt --- .../efdc_fortran_dll/EfdcFortranDLL.vfproj | 277 ++++++++++++------ 1 file changed, 186 insertions(+), 91 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index cd2c5cc2c..5f38adee6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -2,68 +2,163 @@ - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -74,21 +169,21 @@ - - - + - + + + - - - + - + + + - + - + @@ -100,38 +195,38 @@ - - - + - + + + - - - + - + + + - + - + - - - + - + + + - - - + - + + + - + - + From 9df172310e468cc810761879e5a8d04433655f2e Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 12 Dec 2023 14:39:07 +0100 Subject: [PATCH 42/77] VFPROJ more updates to the vfproj file --- .../efdc_fortran_dll/EfdcFortranDLL.vfproj | 87 +++++++++++++------ 1 file changed, 60 insertions(+), 27 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index 5f38adee6..18e36b9d8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -83,8 +83,8 @@ - - + + @@ -94,8 +94,8 @@ - - + + @@ -105,8 +105,8 @@ - - + + @@ -116,8 +116,8 @@ - - + + @@ -127,8 +127,8 @@ - - + + @@ -138,8 +138,8 @@ - - + + @@ -149,8 +149,8 @@ - - + + @@ -170,16 +170,16 @@ - - - + - + + + @@ -196,16 +196,16 @@ - - - + - + + + @@ -213,16 +213,16 @@ - - - + - + + + @@ -249,7 +249,9 @@ + + @@ -260,24 +262,35 @@ + + + + - + + + + + + + + @@ -286,22 +299,32 @@ + + + + + + + + + + @@ -317,6 +340,7 @@ + @@ -333,6 +357,7 @@ + @@ -343,6 +368,7 @@ + @@ -354,6 +380,7 @@ + @@ -385,6 +412,7 @@ + @@ -400,6 +428,7 @@ + @@ -424,6 +453,7 @@ + @@ -461,6 +491,7 @@ + @@ -473,11 +504,13 @@ + + From a402fefbfe73cb9561a4570baa59c0295bf833f0 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 12 Dec 2023 16:56:47 +0100 Subject: [PATCH 43/77] add missing source file EEXPOUT_opt_mpi --- .../original_efdc_files/EEXPOUT_opt_mpi.for | 966 ++++++++++++++++++ 1 file changed, 966 insertions(+) create mode 100644 model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for new file mode 100644 index 000000000..5f683d0f3 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for @@ -0,0 +1,966 @@ + SUBROUTINE EEXPOUT_opt_mpi(JSEXPLORER) + + !---------------------------------------------------------------- + + ! ** SUBROUTINE EEXPOUT WRITES UNFORMATTED OUTPUT FILES: + ! ** EE_WC - WATER COLUMN AND TOP LAYER OF SEDIMENTS + ! ** EE_BED - SEDIMENT BED LAYER INFORMATION + ! ** EE_WQ - WATER QUALITY INFORMATION FOR THE WATER COLUMN + ! ** EE_SD - SEDIMENT DIAGENSIS INFORMATION + ! ** EE_ARRAYS - GENERAL/USER DEFINED ARRAY DUMP. LINKED TO + ! ** EFDC_EXPLORER FOR DISPLAY + ! ** EE_SEDZLJ - SEDIMENT BED DATA FOR SEDZLJ SUB-MODEL + + !---------------------------------------------------------------- + + ! *** Notes: + + USE GLOBAL + USE MPI + + INTEGER*4 VER + CHARACTER*8 ARRAYNAME + INTEGER*4 IWQ(40), NACTIVE + INTEGER*4 JSEXPLORER,NS,NW,MW,NSEDSTEPS,NSXD + INTEGER*4 L,K,ISYS,NT,NX,N1 + REAL*4 TMPVAL,WQ + REAL*4 ZERO, SHEAR +c REAL SHEAR_1D(LCM),HBED_1D(LCM),BDENBED_1D(LCM),PORBED_1D(LCM) +c REAL SEDB_1D(LCM,NSED),SED_VFRBED_1D(LCM,NSED) +c REAL SNDB_1D(LCM,NSND),SND_VFRBED_1D(LCM,NSND) +c INTEGER N1_1D(LCM) + + INTEGER NP1 + INTEGER COUNTCELL(LA) + + SAVE IWQ + SAVE NSEDSTEPS + + IF(.NOT.ALLOCATED(SEDB_1D))THEN + ALLOCATE(SEDB_1D(LCM,NSED)) + ALLOCATE(SED_VFRBED_1D(LCM,NSED)) + ALLOCATE(SNDB_1D(LCM,NSND)) + ALLOCATE(SND_VFRBED_1D(LCM,NSND)) + SEDB_1D =0. + SED_VFRBED_1D=0. + SNDB_1D =0. + SND_VFRBED_1D=0. + ENDIF + + IF(ISDYNSTP.EQ.0)THEN + DELT=DT + ELSE + DELT=DTDYN + ENDIF + NACTIVE=LA-1 + +!{GEOSR, OIL, CWCHO, 101121 + S1TIME=MPI_TIC() + IF (IDTOX.GE.4440) THEN + ISTRAN(5)=1 + NTOX=1 + DO L=2,LA + DO K=1,KC + COUNTCELL(L)=0 + OILCONC=0.0 + DO NP1=1,NPD + IF(L==LLA(NP1)) THEN + COUNTCELL(L)=COUNTCELL(L)+1 + ENDIF + ENDDO + OILCONC(L,K,1)=OILMASS/REAL(NPD)*REAL(COUNTCELL(L)) + OILCONC(L,K,1)=OILCONC(L,K,1)/(DXP(L)*DYP(L)*HP(L))*1000. ! [mg/L] + TOX(L,K,1)=OILCONC(L,K,1) + ENDDO + ENDDO + ENDIF + MPI_WTIMES(991)=MPI_WTIMES(992)+MPI_TOC(S1TIME) +!} + IF(JSEXPLORER.eq.0)THEN + IF(ISSPH(8).GE.1)THEN + call collect_in_zero_int(KBT) + call collect_in_zero(TAUBSED) + call collect_in_zero(TAUBSND) + call collect_in_zero(TAUB) + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + ENDDO + + call collect_in_zero(RSSBCE) + call collect_in_zero(RSSBCW) + call collect_in_zero(RSSBCN) + call collect_in_zero(RSSBCS) + call collect_in_zero(TBX) + call collect_in_zero(TBY) + + call collect_in_zero(WVWHA) + call collect_in_zero(WVFRQL) + call collect_in_zero(WACCWE) + + call collect_in_zero_array(SAL) + call collect_in_zero_array(TEM) + call collect_in_zero(TEMB) + call collect_in_zero_array(DYE) + call collect_in_zero_array(SFL) + + DO NT=1,NTXM + call collect_in_zero_array_kbm(TOXB(:,:,NT)) + call collect_in_zero_array(TOX(:,:,NT)) + ENDDO + + call collect_in_zero(BELV) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero_array_kbm(PORBED) + + DO NS=1,NSED + call collect_in_zero_array_kbm(SEDB(:,:,NS)) + call collect_in_zero_array_kbm(VFRBED(:,:,NS)) + call collect_in_zero_array(SED(:,:,NS)) + ENDDO + + DO NX=1,NSND + call collect_in_zero_array_kbm(SNDB(:,:,NX)) + call collect_in_zero_array_kbm(VFRBED(:,:,NX+NSED)) + call collect_in_zero_array(SND(:,:,NX)) + call collect_in_zero(CQBEDLOADX(:,NX)) + call collect_in_zero(CQBEDLOADY(:,NX)) + ENDDO + + ENDIF + + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0)THEN + call collect_in_zero_r8(TAU) + call collect_in_zero_r8(D50AVG) + call collect_in_zero_r8(ETOTO) + + DO NT=1,NSCM + call collect_in_zero_r8(CBL(1,:,NT)) + call collect_in_zero_r8(CBL(2,:,NT)) + call collect_in_zero_r8(XBLFLUX(:,NT)) + call collect_in_zero_r8(YBLFLUX(:,NT)) + DO K=1,KB + call collect_in_zero_r8(PER(NT,K,:)) + ENDDO + ENDDO + DO K=1,KB + call collect_in_zero_int(LAYER(K,:)) + call collect_in_zero_r8(TSED(K,:)) + call collect_in_zero_r8(BULKDENS(K,:)) + ENDDO + ENDIF + + IF(ISBEXP.GE.1)THEN + call collect_in_zero_int(KBT) + call collect_in_zero_array_kbm(HBED) + call collect_in_zero_array_kbm(BDENBED) + call collect_in_zero_array_kbm(PORBED) + + DO NT=1,NTOX + call collect_in_zero_array_kbm(TOXB(:,:,NT)) + ENDDO + + DO NS=1,NSED + call collect_in_zero_array_kbm(SEDB(:,:,NS)) + call collect_in_zero_array_kbm(VFRBED(:,:,NS)) + ENDDO + + DO NX=1,NSND + call collect_in_zero_array_kbm(SNDB(:,:,NX)) + call collect_in_zero_array_kbm(VFRBED(:,:,NX+NSED)) + ENDDO + ENDIF + + IF(ISINWV.EQ.2)THEN + call collect_in_zero_array(FXWAVE) + call collect_in_zero_array(FYWAVE) + + call collect_in_zero(HP) + call collect_in_zero_array(AH) + call collect_in_zero_array(AV) + DO K=0,KCM + call collect_in_zero(QQ(:,K)) + ENDDO + + call collect_in_zero_array(FMDUX) + call collect_in_zero_array(FMDUY) + call collect_in_zero_array(FMDVY) + call collect_in_zero_array(FMDVX) + call collect_in_zero_array(U) + call collect_in_zero_array(V) + + call collect_in_zero(UHDYE) + call collect_in_zero(VHDXE) + + call collect_in_zero(FXE) + call collect_in_zero(FYE) + call collect_in_zero(DXIU) + call collect_in_zero(DYIV) + call collect_in_zero(AHC(:,1)) + call collect_in_zero(AHC(:,2)) + + call collect_in_zero_array(AHU) + call collect_in_zero_array(AMCU) + call collect_in_zero_array(AMCV) + call collect_in_zero_array(AMSU) + ENDIF + + DO NW=0,NWQV + call collect_in_zero_array(WQV(:,:,NW)) + ENDDO + DO NSP=1,NXSP + call collect_in_zero_array(WQVX(:,:,NSP)) + ENDDO + + IF(PRINT_SUM)THEN + IF(MYRANK.EQ.0)THEN + PRINT*,n,'TAUBSED ',sum(abs(dble(TAUBSED))) + PRINT*,n,'TAUBSND ',sum(abs(dble(TAUBSND))) + PRINT*,n,'TAUB ',sum(abs(dble(TAUB))) + PRINT*,n,'RSSBCE ',sum(abs(dble(RSSBCE))) + PRINT*,n,'RSSBCW ',sum(abs(dble(RSSBCW))) + PRINT*,n,'RSSBCN ',sum(abs(dble(RSSBCN))) + PRINT*,n,'RSSBCS ',sum(abs(dble(RSSBCS))) + PRINT*,n,'TBX ',sum(abs(dble(TBX))) + PRINT*,n,'TBY ',sum(abs(dble(TBY))) + PRINT*,n,'WVWHA ',sum(abs(dble(WVWHA))) + PRINT*,n,'WVFRQL ',sum(abs(dble(WVFRQL))) + PRINT*,n,'WACCWE ',sum(abs(dble(WACCWE))) + PRINT*,n,'SAL ',sum(abs(dble(SAL))) + PRINT*,n,'TEM ',sum(abs(dble(TEM))) + PRINT*,n,'TEMB ',sum(abs(dble(TEMB))) + PRINT*,n,'DYE ',sum(abs(dble(DYE))) + PRINT*,n,'SFL ',sum(abs(dble(SFL))) + PRINT*,n,'TOXB ',sum(abs(dble(TOXB))) + PRINT*,n,'TOX ',sum(abs(dble(TOX))) + PRINT*,n,'HBED ',sum(abs(dble(HBED))) + PRINT*,n,'BDENBED ',sum(abs(dble(BDENBED))) + PRINT*,n,'PORBED ',sum(abs(dble(PORBED))) + PRINT*,n,'KBT ',sum(abs(dble(KBT))) + PRINT*,n,'SEDB ',sum(abs(dble(SEDB))) + PRINT*,n,'VFRBED ',sum(abs(dble(VFRBED))) + PRINT*,n,'SNDB ',sum(abs(dble(SNDB))) + PRINT*,n,'VFRBED ',sum(abs(dble(VFRBED))) + PRINT*,n,'CQBEDLOADX ',sum(abs(dble(CQBEDLOADX))) + PRINT*,n,'CQBEDLOADY ',sum(abs(dble(CQBEDLOADY))) + PRINT*,n,'WQV ',sum(abs(dble(WQV))) + PRINT*,n,'WQVX ',sum(abs(dble(WQVX))) + ENDIF + ENDIF + ENDIF + +C ** INITIAL CALL + S1TIME=MPI_TIC() + IF(JSEXPLORER.EQ.1.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=106 + WRITE(95)VER + WRITE(95)ISTRAN(1),ISTRAN(2),ISTRAN(3),ISTRAN(4) + WRITE(95)ISTRAN(5),ISTRAN(6),ISTRAN(7) + WRITE(95)NSED,NSND,KB,KC,NTOX + NSXD=NSED+NSND + DO NS=1,NSXD + WRITE(95)SEDDIA(NS) + ENDDO + CLOSE(95,STATUS='KEEP') + + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0)THEN + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)ITBM,NSICM + CLOSE(95,STATUS='KEEP') + ENDIF + + IF(ISBEXP.GE.1)THEN + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN + OPEN(10,FILE='EE_BED.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(10,STATUS='DELETE') + OPEN(10,FILE='EE_BED.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=106 + WRITE(10)VER + WRITE(10)ISTRAN(1),ISTRAN(2),ISTRAN(3),ISTRAN(4) + WRITE(10)ISTRAN(5),ISTRAN(6),ISTRAN(7) + WRITE(10)NSED,NSND,KB,KC,NTOX + DO NS=1,NSXD + WRITE(10)SEDDIA(NS) + ENDDO + CLOSE(10,STATUS='KEEP') + ENDIF + ENDIF + + IF(ISTRAN(8).GT.0)THEN + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NWQV + WRITE(95)(ISTRWQ(NW),NW=1,NWQV) + IWQ=0 + DO MW=1,NWQV + IWQ(MW)=ISTRWQ(MW) + ENDDO + WRITE(95)(IWQ(NW),NW=1,NWQV) + CLOSE(95,STATUS='KEEP') +!{ GEOSR X-species : jgcho 2015.10.14 + if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NXSP,LA,KC + CLOSE(95,STATUS='KEEP') + endif ! if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 +!} GEOSR X-species : jgcho 2015.10.14 + + ! *** SAVE SEDIMENT DIAGENESIS RESULTS + IF(ISSDBIN.LT.0)THEN + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)NACTIVE + CLOSE(95,STATUS='KEEP') + NSEDSTEPS=-1 + ENDIF + ENDIF + ELSEIF(JSEXPLORER.EQ.-1)THEN + ! *** FORCE ALL OUTPUT + NSEDSTEPS=32000 + ENDIF + MPI_WTIMES(992)=MPI_WTIMES(992)+MPI_TOC(S1TIME) + +C *** WRITE SNAPSHOT + S1TIME=MPI_TIC() + IF(ISDYNSTP.EQ.0)THEN + EETIME=DT*FLOAT(N)+TCON*TBEGIN + ELSE + EETIME=TIMESEC + ENDIF + IF(JSEXPLORER.EQ.1)EETIME=TCON*TBEGIN + EETIME=EETIME/86400. + + IF(ISSPH(8).GE.1.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_WC.OUT',STATUS='OLD', + & POSITION='APPEND',FORM='UNFORMATTED') + WRITE(95)EETIME,NACTIVE + IF(.FALSE.)THEN + + DO L=2,LA + N1=KBT(L) + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + IF(ISBEDSTR.GE.1.AND.NSEDFLUME.EQ.0)THEN + WRITE(95)TAUBSED(L) + IF(ISBEDSTR.EQ.1)THEN + WRITE(95)TAUBSND(L) + ENDIF + ELSE + WRITE(95)TAUB(L) + ENDIF + ELSE + SHEAR=MAX(QQ(L,0),QQMIN)/CTURB2 + WRITE(95)SHEAR + ENDIF + IF(ISWAVE.GE.1)THEN + ! *** Shear due to Current Only + SHEAR = (RSSBCE(L)*TBX(L+1 )+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TBY(LNC(L))+RSSBCS(L)*TBY(L))**2 + SHEAR=0.5*SQRT(SHEAR) + WRITE(95)SHEAR + IF(ISWAVE.EQ.3)THEN + WRITE(95)WVWHA(L),WVFRQL(L),WACCWE(L) + ENDIF + ENDIF + IF(ISTRAN(1).EQ.1)WRITE(95)(SAL(L,K),K=1,KC) + IF(ISTRAN(2).EQ.1)THEN + WRITE(95)(TEM(L,K),K=1,KC) + IF(TBEDIT.GT.0.)WRITE(95)TEMB(L) + ENDIF + IF(ISTRAN(3).EQ.1)WRITE(95,ERR=999,IOSTAT=ISYS) + & (DYE(L,K),K=1,KC) + IF(ISTRAN(4).EQ.1)WRITE(95)(SFL(L,K),K=1,KC) + IF(ISTRAN(5).EQ.1)THEN + WRITE(95)(TOXB(L,N1,NT),NT=1,NTOX) + WRITE(95)((TOX(L,K,NT),K=1,KC),NT=1,NTOX) + ENDIF + IF(ISTRAN(6).EQ.1.OR.ISTRAN(7).GE.1)THEN + WRITE(95)N1,BELV(L),HBED(L,N1),BDENBED(L,N1),PORBED(L,N1) + IF(ISTRAN(6).EQ.1)THEN + WRITE(95)(SEDB(L,N1,NS),VFRBED(L,N1,NS),NS=1,NSED) + WRITE(95)((SED(L,K,NS),K=1,KC),NS=1,NSED) + ENDIF + IF(ISTRAN(7).EQ.1)THEN + WRITE(95)(SNDB(L,N1,NX),VFRBED(L,N1,NX+NSED),NX=1,NSND) + WRITE(95)((SND(L,K,NX),K=1,KC),NX=1,NSND) + IF(ISBDLDBC.GT.0)THEN + WRITE(95)(CQBEDLOADX(L,NX),CQBEDLOADY(L,NX),NX=1,NSND) + ENDIF + ENDIF + ENDIF + ENDDO + + ELSE + + IF(ISTRAN(6).GT.0.OR.ISTRAN(7).GT.0)THEN + IF(ISBEDSTR.GE.1.AND.NSEDFLUME.EQ.0)THEN + WRITE(95) TAUBSED + IF(ISBEDSTR.EQ.1)THEN + WRITE(95) TAUBSND + ENDIF + ELSE + WRITE(95) TAUB + ENDIF + ENDIF + + IF(ISWAVE.GE.1)THEN + DO L=2,LA + SHEAR_1D(L) = (RSSBCE(L)*TBX(L+1 )+RSSBCW(L)*TBX(L))**2 + & +(RSSBCN(L)*TBY(LNC(L))+RSSBCS(L)*TBY(L))**2 + SHEAR_1D(L)=0.5*SQRT(SHEAR_1D(L)) + ENDDO + WRITE(95) SHEAR_1D + IF(ISWAVE.EQ.3)THEN + WRITE(95) WVWHA + WRITE(95) WVFRQL + WRITE(95) WACCWE + ENDIF + ENDIF + + IF(ISTRAN(1).EQ.1) WRITE(95) SAL + IF(ISTRAN(2).EQ.1)THEN + WRITE(95) TEM + IF(TBEDIT.GT.0.) WRITE(95) TEMB + ENDIF + + IF(ISTRAN(3).EQ.1) WRITE(95) DYE + IF(ISTRAN(4).EQ.1) WRITE(95) SFL + IF(ISTRAN(5).EQ.1)THEN + WRITE(95) TOXB + WRITE(95) TOX + ENDIF + + IF(ISTRAN(6).EQ.1.OR.ISTRAN(7).GE.1)THEN + DO L=2,LA + N1=KBT(L) + N1_1D(L)=N1 + HBED_1D(L)=HBED(L,N1) + BDENBED_1D(L)=BDENBED(L,N1) + PORBED_1D(L)=PORBED(L,N1) + ENDDO + WRITE(95) N1_1D + WRITE(95) BELV + WRITE(95) HBED_1D + WRITE(95) BDENBED_1D + WRITE(95) PORBED_1D + + IF(ISTRAN(6).EQ.1)THEN + DO NS=1,NSED + DO L=2,LA + N1=KBT(L) + SEDB_1D(L,NS)=SEDB(L,N1,NS) + SED_VFRBED_1D(L,NS)=VFRBED(L,N1,NS) + ENDDO + ENDDO + WRITE(95) SEDB_1D + WRITE(95) SED_VFRBED_1D + WRITE(95) SED + ENDIF + + IF(ISTRAN(7).EQ.1)THEN + DO NX=1,NSND + DO L=2,LA + N1=KBT(L) + SNDB_1D(L,NX)=SNDB(L,N1,NX) + SND_VFRBED_1D(L,NX)=VFRBED(L,N1,NX+NSED) + ENDDO + ENDDO + WRITE(95) SNDB_1D + WRITE(95) SND_VFRBED_1D + WRITE(95) SND + IF(ISBDLDBC.GT.0)THEN + WRITE(95) CQBEDLOADX + WRITE(95) CQBEDLOADY + ENDIF + ENDIF + + ENDIF + + ENDIF + + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + ENDIF + MPI_WTIMES(993)=MPI_WTIMES(993)+MPI_TOC(S1TIME) + + ! *** OUTPUT THE SEDZLJ VARIABLES + S1TIME=MPI_TIC() + IF(ISTRAN(6).GT.0.AND.NSEDFLUME.GT.0.AND.MYRANK.EQ.0)THEN + OPEN(95,FILE='EE_SEDZLJ.OUT',STATUS='OLD', + & POSITION='APPEND',FORM='UNFORMATTED') + + WRITE(95)EETIME,NACTIVE + + DO L=2,LA + WRITE(95) REAL(TAU(L)) !TAU(LCM) - Shear Stress in dynes/cm^2 + WRITE(95) REAL(D50AVG(L)) !D50AVG(LCM) - Average particle size of bed surface (microns) + WRITE(95) REAL(ETOTO(L)) !ETOTO(LCM) - Total erosion in the cell + DO NT=1,NSCM + WRITE(95) REAL(CBL(1,L,NT)) !CBL(NSCM,LCM) - This is the bedload concentration in g/cm^3 of each size class + WRITE(95) REAL(XBLFLUX(L,NT)) !XBLFLUX(LCM,NSCM) - Bedload flux in X direction (g/s) + WRITE(95) REAL(YBLFLUX(L,NT)) !YBLFLUX(LCM,NSCM) - Bedload flux in Y direction (g/s) + DO K=1,KB + WRITE(95) REAL(PER(NT,K,L)) !PER(NSCM,KB,LCM) - This is the mass percentage of each size class in a layer + ENDDO + ENDDO + DO K=1,KB + WRITE(95) LAYER(K,L) !LAYER(KB,LCM) - This is = 1 when a bed layer (KB index) exists with mass + WRITE(95) REAL(TSED(K,L)) !TSED(KB,LCM) - This is the mass in g/cm^2 in each layer + WRITE(95) REAL(BULKDENS(K,L)) !BULKDENS(KB,LCM) - Dry Bulk density of each layer (g/cm^3) + ENDDO + ENDDO + + IF(MYRANK.EQ.0) CALL FLUSH(95) + IF(MYRANK.EQ.0) CLOSE(95,STATUS='KEEP') + ENDIF + MPI_WTIMES(994)=MPI_WTIMES(994)+MPI_TOC(S1TIME) + +C *** NOW OUTPUT ALL THE BEDINFO TO A SINGLE FILE + S1TIME=MPI_TIC() + IF(ISBEXP.GE.1.AND.MYRANK.EQ.0)THEN + IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1.AND.KB.GT.1)THEN + OPEN(87,FILE='EE_BED.OUT',STATUS='UNKNOWN',POSITION='APPEND' + & ,FORM='UNFORMATTED') + WRITE(87)EETIME,NACTIVE + DO L=2,LA + WRITE(87)KBT(L) + ENDDO + DO L=2,LA + DO K=1,KB + WRITE(87)HBED(L,K),BDENBED(L,K),PORBED(L,K) + IF(ISTRAN(6).GE.1)THEN + DO NS=1,NSED + WRITE(87)SEDB(L,K,NS),VFRBED(L,K,NS) + ENDDO + ENDIF + IF(ISTRAN(7).GE.1)THEN + DO NX=1,NSND + NS=NSED+NX + WRITE(87)SNDB(L,K,NX),VFRBED(L,K,NS) + ENDDO + ENDIF + IF(ISTRAN(5).GE.1)THEN + DO NT=1,NTOX + WRITE(87)TOXB(L,K,NT) + ENDDO + ENDIF + ENDDO + ENDDO + CALL FLUSH(87) + CLOSE(87,STATUS='KEEP') + ENDIF + ENDIF + MPI_WTIMES(995)=MPI_WTIMES(995)+MPI_TOC(S1TIME) + +C *** INTERNAL ARRAYS + S1TIME=MPI_TIC() + IF(ISINWV.EQ.2.AND.JSEXPLORER.LE.0.AND.MYRANK.EQ.0)THEN + ZERO=0.0 + IF(N.LT.(2*NTSPTC/NPSPH(8)))THEN + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN') + CLOSE(95,STATUS='DELETE') + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN', + & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') + VER=100 + WRITE(95)VER + WRITE(95)3 ! # OF TIME VARYING ARRAYS + + ! FLAGS: ARRAY TYPE, TIME VARIABLE + ! ARRAY TYPE: 0 = L DIM'D + ! 1 = L,KC DIM'D + ! 2 = L,0:KC DIM'D + ! 3 = L,KB DIM'D + ! 4 = L,KC,NCLASS DIM'D + ! TIME VARIABLE: 0 = NOT CHANGING + ! 1 = TIME VARYING + + !WRITE(95)0,0 + !ARRAYNAME='SUB' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)SUB(L) + !ENDDO + + !WRITE(95)0,0 + !ARRAYNAME='SVB' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)SVB(L) + !ENDDO + + WRITE(95)1,0 + ARRAYNAME='FXWAVE' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FXWAVE(L,K) + ENDDO + ENDDO + + WRITE(95)1,0 + ARRAYNAME='FYWAVE' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FYWAVE(L,K) + ENDDO + ENDDO + + ELSE + OPEN(95,FILE='EE_ARRAYS.OUT',STATUS='UNKNOWN', + & POSITION='APPEND',FORM='UNFORMATTED') + ENDIF + + IF(.TRUE.)THEN + + WRITE(95)1,1 + ARRAYNAME='AH' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AH(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='AV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)(AV(L,K)*HP(L)) + ENDDO + ENDDO + + WRITE(95)2,1 + ARRAYNAME='QQ' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=0,KC + WRITE(95)QQ(L,K) + ENDDO + ENDDO + + IF(.FALSE.)THEN + ! *** FMDUX FMDUY FMDVY FMDVX + WRITE(95)1,1 + ARRAYNAME='FMDUX' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDUX(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='FMDUY' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDUY(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FMDVY' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDVY(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FMDVX' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)FMDVX(L,K) + ENDDO + ENDDO + + WRITE(95)1,1 + ARRAYNAME='U' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)U(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='V' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)V(L,K) + ENDDO + ENDDO + + WRITE(95)0,1 + ARRAYNAME='UHDYE' + WRITE(95)ARRAYNAME + DO L=2,LA + WRITE(95)UHDYE(L) + ENDDO + + WRITE(95)0,1 + ARRAYNAME='VHDXE' + WRITE(95)ARRAYNAME + DO L=2,LA + WRITE(95)VHDXE(L) + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FXE' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=FXE(L)*DELT*DXIU(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FYE' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=FYE(L)*DELT*DYIV(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FUHX' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=AHC(L,1)*DELT*DXIU(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)0,1 + ARRAYNAME='FVHY' + WRITE(95)ARRAYNAME + DO L=2,LA + TMPVAL=AHC(L,2)*DELT*DYIV(L) + WRITE(95)TMPVAL + ENDDO + + WRITE(95)1,1 + ARRAYNAME='FUHU' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AHU(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FVHU' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMCU(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FVHV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMCV(L,K) + ENDDO + ENDDO + WRITE(95)1,1 + ARRAYNAME='FUHV' + WRITE(95)ARRAYNAME + DO L=2,LA + DO K=1,KC + WRITE(95)AMSU(L,K) + ENDDO + ENDDO + + ENDIF + + !WRITE(95)0,1 + !ARRAYNAME='TATMT' + !WRITE(95)ARRAYNAME + !DO L=2,LA + ! WRITE(95)TATMT(L) + !ENDDO + ENDIF +C + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + + ENDIF + MPI_WTIMES(996)=MPI_WTIMES(996)+MPI_TOC(S1TIME) + +C *** WATER QUALITY + IF(ISTRAN(8).GT.0.AND.MYRANK.EQ.0)THEN + ! 1) CHC - cyanobacteria + ! 2) CHD - diatom algae + ! 3) CHG - green algae + ! 4) ROC - refractory particulate organic carbon + ! 5) LOC - labile particulate organic carbon + ! 6) DOC - dissolved organic carbon + ! 7) ROP - refractory particulate organic phosphorus + ! 8) LOP - labile particulate organic phosphorus + ! 9) DOP - dissolved organic phosphorus + ! 10) P4D - total phosphate + ! 11) RON - refractory particulate organic nitrogen 22) macroalgae + ! 12) LON - labile particulate organic nitrogen + ! 13) DON - dissolved organic nitrogen + ! 14) NHX - ammonia nitrogen + ! 15) NOX - nitrate nitrogen + ! 16) SUU - particulate biogenic silica + ! 17) SAA - dissolved available silica + ! 18) COD - chemical oxygen demand + ! 19) DOX - dissolved oxygen + ! 20) TAM - total active metal + ! 21) FCB - fecal coliform bacteria + S1TIME=MPI_TIC() + OPEN(95,FILE='EE_WQ.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME + IF(.FALSE.)THEN + DO L=2,LA + DO K=1,KC + DO NW=1,NWQV + IF(IWQ(NW).GT.0)THEN + WQ=WQV(L,K,NW) + WRITE(95)WQ + ENDIF + ENDDO + ENDDO + ENDDO + ELSE + DO NW=1,NWQV + IF(IWQ(NW).GT.0)THEN + WRITE(95) WQV(:,:,NW) + ENDIF + ENDDO + ENDIF + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + MPI_WTIMES(997)=MPI_WTIMES(997)+MPI_TOC(S1TIME) +!{ GEOSR X-species : jgcho 2015.10.14 + S1TIME=MPI_TIC() + if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + OPEN(95,FILE='EE_WQX.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME,N + IF(.FALSE.)THEN + DO NSP=1,NXSP + DO K=1,KC + DO L=2,LA + WQ=WQVX(L,K,NSP) + WRITE(95)WQ + ENDDO + ENDDO + ENDDO + ELSE + DO NSP=1,NXSP + WRITE(95) WQVX(:,:,NSP) + ENDDO + ENDIF + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + endif !if (NXSP.gt.0) then !{ GEOSR X-species : jgcho 2015.10.15 + MPI_WTIMES(998)=MPI_WTIMES(998)+MPI_TOC(S1TIME) +!} GEOSR X-species : jgcho 2015.09.18 + ! *** SAVE SEDIMENT DIAGENESIS RESULTS + S1TIME=MPI_TIC() + IF(IWQBEN.GT.0.AND.ISSDBIN.LT.0)THEN + ! *** IF JSEXPLORER=1 THEN WRITE THE ARRAYS (I.E. IC'S) + NSEDSTEPS=NSEDSTEPS+1 + IF(NSEDSTEPS.GE.ABS(ISSDBIN).OR.JSEXPLORER.EQ.1)THEN + OPEN(95,FILE='EE_SD.OUT',STATUS='UNKNOWN',POSITION='APPEND', + & FORM='UNFORMATTED') + WRITE(95)EETIME + DO L=2,LA + + ! SMPON = Conc. Particulate Org. Nitrogen in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + ! SMPOP = Conc. Particulate Org. Phosphorus in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + ! SMPOC = Conc. Particulate Org. Carbon in G-class 1, 2 & 3 (g/m3) dim(LA,NSMGM) + + ! *** DEPOSITION FLUXES + ! SMDFN(LL,?) = Sediment Flux To The Sediment Bed From PON Into G1, G2, & G3 + ! SMDFP(LL,?) = Sediment Flux To The Sediment Bed From POP Into G1, G2, & G3 + ! SMDFC(LL,?) = Sediment Flux To The Sediment Bed From POC Into G1, G2, & G3 + + ! SM1NH4 = Conc. NH4-N in layer 1 (g/m3) dim(LA) + ! SM2NH4 = Conc. NH4-N in layer 2 (g/m3) + ! SM1NO3 = Conc. NO3-N in layer 1 (g/m3) + ! SM2NO3 = Conc. NO3-N in layer 2 (g/m3) + ! SM1PO4 = Conc. PO4-P in layer 1 (g/m3) + ! SM2PO4 = Conc. PO4-P in layer 2 (g/m3) + ! SM1H2S = Conc. Sulfide (H2S) in layer 1 (g/m3) + ! SM2H2S = Conc. Sulfide (H2S) in layer 2 (g/m3) + ! SMPSI = Conc. Particulate biogenic silica in layer 2 (g/m3) + ! SM1SI = Conc. Dissolved available silica in layer 1 (g/m3) + ! SM2SI = Conc. Dissolved available silica in layer 2 (g/m3) + ! SMBST = Accumulated benthic stress (days) + ! SMT = Sediment temperature (degC) + + ! *** SEDIMENT OXYGEN DEMANDS + ! SMCSOD = CARBONACEOUS SOD + ! SMNSOD = NITROGENOUS SOD + + ! *** BENTHIC FLUXES + ! WQBFNH4 = AMMONIUM FLUX + ! WQBFNO3 = NITRATE FLUX + ! WQBFO2 = O2 SEDIMENT FLUX (SOD) + ! WQBFCOD = COD FLUX + ! WQBFPO4D = PO4 FLUX + ! WQBFSAD = SILICA FLUX + + WRITE(95)(SMPON(L,K),K=1,3) + WRITE(95)(SMPOP(L,K),K=1,3) + WRITE(95)(SMPOC(L,K),K=1,3) + WRITE(95)(SMDFN(L,K),K=1,3) + WRITE(95)(SMDFP(L,K),K=1,3) + WRITE(95)(SMDFC(L,K),K=1,3) + WRITE(95)SM1NH4(L),SM2NH4(L) + WRITE(95)SM1NO3(L),SM2NO3(L) + WRITE(95)SM1PO4(L),SM2PO4(L) + WRITE(95)SM1H2S(L),SM2H2S(L) + WRITE(95)SM1SI(L), SM2SI(L) + WRITE(95)SMPSI(L) + WRITE(95)SMBST(L),SMT(L) + WRITE(95)SMCSOD(L),SMNSOD(L) + WRITE(95)WQBFNH4(L),WQBFNO3(L),WQBFO2(L),WQBFCOD(L), + & WQBFPO4D(L),WQBFSAD(L) + ENDDO + CALL FLUSH(95) + CLOSE(95,STATUS='KEEP') + NSEDSTEPS=0 + ENDIF + ENDIF + ENDIF + MPI_WTIMES(999)=MPI_WTIMES(999)+MPI_TOC(S1TIME) + + RETURN + + 999 STOP ' Error writing SNAPSHOT file' + END From e749cca898253f4cb5a007122b207a6593934187 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 14 Dec 2023 09:50:27 +0100 Subject: [PATCH 44/77] VFPROJ: more updates --- .../efdc_fortran_dll/EfdcFortranDLL.vfproj | 31 ++++++++++--------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index 18e36b9d8..a43eb0ac6 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -83,8 +83,8 @@ - - + + @@ -94,8 +94,8 @@ - - + + @@ -105,8 +105,8 @@ - - + + @@ -116,8 +116,8 @@ - - + + @@ -127,8 +127,8 @@ - - + + @@ -138,8 +138,8 @@ - - + + @@ -149,8 +149,8 @@ - - + + @@ -261,6 +261,7 @@ + @@ -358,6 +359,7 @@ + @@ -431,6 +433,7 @@ + From aee29be2c8b828f34ec1375a920958eb7e07e947 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 14 Dec 2023 09:57:08 +0100 Subject: [PATCH 45/77] fixup! Add MPI init, finialise, and subroutine calls --- .../native/efdc_fortran_dll/openDA_wrapper/model_init.f90 | 1 + .../efdc_fortran_dll/openDA_wrapper/model_make_step.f90 | 4 ++-- .../native/efdc_fortran_dll/openDA_wrapper/model_state.f90 | 1 + 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 index bf69eca9f..cefd78b48 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init.f90 @@ -1,6 +1,7 @@ subroutine model_init use global + use mpi ! arguments !real, intent(out) :: time_period diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 index 1ff8e1e18..690c6c350 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_make_step.f90 @@ -15,9 +15,9 @@ subroutine model_make_step(time_period) NITERAT=0 IF(IS2TIM.EQ.0) then write(*,'(A,F8.4,A,F6.1,A)') "time integration with HDMT from day ", TBEGIN, ' over ', time_period / 60.0, ' minutes' - CALL HDMT_mpi + CALL HDMT elseif (IS2TIM.GE.1) then - write(*,'(A,F8.4,A,F6.1,A)') "time integration with HDMT2T from day ", TBEGIN, ' over ', time_period / 60.0, ' minutes' + write(*,'(A,F8.4,A,F6.1,A)') "time integration with HDMT2T_mpi from day ", TBEGIN, ' over ', time_period / 60.0, ' minutes' CALL HDMT2T_mpi end if diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 index 4ee7a2def..b56b809f0 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_state.f90 @@ -534,6 +534,7 @@ function model_set_state(id) result(ret_val) WQV, WQVX,& ISRESTI, TIMEDAY, NXSP use model_extra_global + use mpi implicit none From d842b3432d77464f5fcc719c7be94b2902674815 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Thu, 14 Dec 2023 13:50:49 +0100 Subject: [PATCH 46/77] wip: some were not initialised!! --- .../original_efdc_files/VARALLOC1.for | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARALLOC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARALLOC1.for index fc709d166..ace41014d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARALLOC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARALLOC1.for @@ -2,6 +2,28 @@ USE GLOBAL C + ALLOCATE(DZCB_2D(LCM,KCM)) + ALLOCATE(BK_2D(LCM,KCM)) + ALLOCATE(DBK_1D(LCM)) + ALLOCATE(SHEAR_1D(LCM)) + ALLOCATE(HBED_1D(LCM)) + ALLOCATE(BDENBED_1D(LCM)) + ALLOCATE(PORBED_1D(LCM)) + ALLOCATE(N1_1D(LCM)) + ALLOCATE(CLOE_TMP(NBBEM,KCM,NSTVM)) + ALLOCATE(CLON_TMP(NBBNM,KCM,NSTVM)) + ALLOCATE(CLOS_TMP(NBBSM,KCM,NSTVM)) + ALLOCATE(CLOW_TMP(NBBWM,KCM,NSTVM)) + + ALLOCATE(NLOE_TMP(NBBEM,KCM,NSTVM)) + ALLOCATE(NLON_TMP(NBBNM,KCM,NSTVM)) + ALLOCATE(NLOS_TMP(NBBSM,KCM,NSTVM)) + ALLOCATE(NLOW_TMP(NBBWM,KCM,NSTVM)) + ALLOCATE(CSERT_TMP(KCM,0:NCSERM,NSTVM)) + ALLOCATE(CSERT_SUM(KCM,0:NCSERM,NSTVM)) + + + ALLOCATE(AAU(LCM)) ALLOCATE(AAV(LCM)) ALLOCATE(AB(LCM,KSM)) From 29c22b7ef0bc0eda42c1fece81a34d72ccfe389c Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 18 Dec 2023 11:28:50 +0100 Subject: [PATCH 47/77] VFPROJ another update --- .../efdc_fortran_dll/EfdcFortranDLL.vfproj | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index a43eb0ac6..acd80902f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -83,7 +83,7 @@ - + @@ -94,7 +94,7 @@ - + @@ -105,7 +105,7 @@ - + @@ -116,7 +116,7 @@ - + @@ -127,7 +127,7 @@ - + @@ -138,7 +138,7 @@ - + @@ -149,7 +149,7 @@ - + @@ -170,16 +170,16 @@ - - - + - + + + @@ -196,16 +196,16 @@ - - - + - + + + @@ -213,16 +213,16 @@ - - - + - + + + From a00e6c18f7c6d790be92be06146fc7bc0cc29950 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 18 Dec 2023 15:13:11 +0100 Subject: [PATCH 48/77] fixup! wip: some were not initialised!! --- .../original_efdc_files/VARZEROInt.f90 | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 index dbe830726..6bcf9300f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 @@ -448,4 +448,25 @@ SUBROUTINE VARZEROInt IWQBENOX=0 TIME_NUM=0 IBIN_TYPE=0 + + DZCB_2D =0 + BK_2D =0 + DBK_1D =0 + SHEAR_1D =0 + HBED_1D =0 + BDENBED_1D =0 + PORBED_1D =0 + N1_1D =0 + CLOE_TMP =0 + CLON_TMP =0 + CLOS_TMP =0 + CLOW_TMP =0 + NLOE_TMP =0 + NLON_TMP =0 + NLOS_TMP =0 + NLOW_TMP =0 + CSERT_TMP =0 + CSERT_SUM =0 + + END From ccd9fdb50caec64c18236b24407935d4e2b003d1 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 12:56:56 +0100 Subject: [PATCH 49/77] Fix issue with reallocating space for cser series --- .../efdc_fortran_dll/openDA_wrapper/model_cser_time_series.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_cser_time_series.f90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_cser_time_series.f90 index dbc2ba028..e4947990a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_cser_time_series.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_cser_time_series.f90 @@ -222,7 +222,7 @@ function enlarge_cser_time_series(id,size_n,size_k,size_m) result(ret_val) if ((size_n > csert(id)%NDCSER)) then !reallocate instance memory - if (debug) print*, "enlarge_cser_time_series", id, n, m + if (debug) print*, "enlarge_cser_time_series", id, n, m , k if (debug) print*, "enlarge_cser_time_series", id, size_n, size_m, size_k allocate(csert_new%MCSER(new_m,NSTVM)) @@ -282,6 +282,7 @@ function enlarge_cser_time_series(id,size_n,size_k,size_m) result(ret_val) CSER(1:n,1:k,1:m,:)= CSER_orig deallocate(TCSER_orig, CSER_orig) + ndcser_max= NDCSER !ALLOCATE(CSERT_EFDC(KCM,0:NCSERM,NSTVM)) !ALLOCATE(MCTLAST(NCSERM,NSTVM)) From 8fc97bf70d9d2616b2a359c8f7af210f230a75d8 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:05:21 +0100 Subject: [PATCH 50/77] Initialize TIMESEC --- .../native/efdc_fortran_dll/original_efdc_files/VARINIT.for | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for index 2ba28a9ff..f4feffcf2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARINIT.for @@ -30,7 +30,8 @@ C NWQPSRM=1 C NWQTDM=1 NOT USED NWQZM=1 - NXYSDATM=1 + NXYSDATM=1 + TIMESEC=0.0 C CALL SCANEFDC(NCSER1,NCSER2,NCSER3,NCSER4) IF(IWRSP(1)==98.OR.IWRSP(1)==99)CALL SCANSEDZLJ From ac20b800bb3a5ad41d89e127842c10aed865bf4c Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:11:21 +0100 Subject: [PATCH 51/77] Fix format specifiers --- .../openDA_wrapper/model_init_3.for | 2 +- .../openDA_wrapper/openDA_wrapper.F90 | 21 +++++++++++-------- .../original_efdc_files/READWIMS1.for | 2 +- 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for index 3588a225c..39228d43e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for @@ -986,7 +986,7 @@ C ENDIF 5300 FORMAT(' M BELSURF ASURFEL ', & ' VOLSEL',/) - 5301 FORMAT(1X,I3,2X,F10.5,2X,E12.4,2X,E12.4) + 5301 FORMAT(1X,I4,2X,F10.5,2X,E12.4,2X,E12.4) 5302 FORMAT(/) 5303 FORMAT(2X,F10.5,3(2X,E12.4)) C diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 index 41997e392..928b8fef8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 @@ -82,7 +82,7 @@ module m_openda_wrapper integer :: dm_model_instance_count = 0 ! actual #instance integer :: dm_model_instance_in_memory = 0 ! index of the instance currenty in memory - logical, parameter :: debug = .false. + logical, parameter :: debug = .true. logical :: ATM_WARNING_REQUIRED = .true. contains @@ -191,6 +191,9 @@ function m_openda_wrapper_init_(parent_directory_c, template_directory_c)& if (ret_val == 0 ) then write(dm_general_log_handle,'(A, I2)') "integer kind: ", kind(NTC) write(dm_general_log_handle,'(A, I2)') "real kind: ", kind(TIDALP) + print*, 'TBEGIN, TCON =', TBEGIN, TCON + + TIMEDAY = TBEGIN* TCON / 86400.d0 ! store sizes of time series (the global ones are redetermined each time we do a restart) @@ -828,7 +831,7 @@ function m_openda_wrapper_get_current_time_(instance, current_time)& !current_time = dble(state(instance)%timesec) / 86400.0d0 current_time = real( dt * nint( state(instance)%timesec/ dt), c_double) / 86400.0d0 ret_val = 0 - + write(dm_outfile_handle(instance), '(A,I4,A,F14.10,A)') & 'get_current_time( instance: ', instance, ', current_time: ' , current_time, ')' call flush(dm_outfile_handle(instance)) @@ -1099,7 +1102,7 @@ function m_openda_wrapper_get_times_for_ei_(instance, exchange_item_id, bc_index if (ret_val < 0) then write(dm_outfile_handle(instance),'(A,I2,A,I4,A,I4)') 'Error in get_times_for_ei: ', ret_val, ' for ', exchange_item_id else - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I4,A)') 'get_times_for_ei( instance: ', instance, & + write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I8,A)') 'get_times_for_ei( instance: ', instance, & ', exchange_item_id: ', exchange_item_id, ', bc_index: ' , bc_index, ', values_count: ', values_count ,')' write(dm_outfile_handle(instance),*) times(1:min(9,values_count)) if ( values_count .ge. 13 ) then @@ -1288,7 +1291,7 @@ function m_openda_wrapper_set_times_for_ei_(instance, exchange_item_id, bc_index if (ret_val < 0) then write(dm_outfile_handle(instance),'(A,I2,A,I4)') 'Error in set_times_for_ei: ', ret_val, ' for ', exchange_item_id else - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I4,A)') 'set_times_for_ei( instance: ', instance, & + write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I8,A)') 'set_times_for_ei( instance: ', instance, & ', exchange_item_id: ', exchange_item_id, ', bc_index: ' , bc_index, ', values_count: ', values_count ,')' write(dm_outfile_handle(instance),'(A,F8.4)') 'conversion_factor: ', factor write(dm_outfile_handle(instance),*) times(1:min(9,values_count)) @@ -1614,7 +1617,7 @@ function m_openda_wrapper_get_values_(instance, exchange_item_id, start_index, e exchange_item_id, ' is not configured in EFDC.' else last_index = end_index - start_index+1 - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A)') 'get_values( exchange_item_id: ', & + write(dm_outfile_handle(instance),'(A,I4,A,I8,A,I8,A)') 'get_values( exchange_item_id: ', & exchange_item_id, ', start_index: ' , start_index, ', end_index: ', end_index, '):' write(dm_outfile_handle(instance),*) values(1:min(9,last_index)) if ( last_index .ge. 13 ) then @@ -1719,7 +1722,7 @@ function m_openda_wrapper_set_values_(instance, exchange_item_id, start_index, e exchange_item_id, ' is not configured in EFDC.' else last_index = end_index - start_index+1 - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A)') 'set_values( exchange_item_id: ', & + write(dm_outfile_handle(instance),'(A,I4,A,I8,A,I8,A)') 'set_values( exchange_item_id: ', & exchange_item_id, ', start_index: ' , start_index, ', end_index: ', end_index, '):' write(dm_outfile_handle(instance),*) values(1:min(9,last_index)) if ( last_index .ge. 13 ) then @@ -2035,7 +2038,7 @@ function m_openda_wrapper_get_times_count_for_time_span_(instance, exchange_item elseif (ret_val < 0) then write(dm_outfile_handle(instance),'(A,I2)') 'Error in get_times_count_for_time_span: ', ret_val else - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I4)') & + write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I8)') & 'get_times_count_for_time_span( instance: ', instance, & ', exchange_item_id: ', exchange_item_id,& ', bc_index: ', bc_index,& @@ -2217,7 +2220,7 @@ function m_openda_wrapper_get_values_for_time_span_(instance, exchange_item_id, exchange_item_id, ' not configured in EFDC.' else last_index = end_index-start_index+1 - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I4,A)') & + write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I8,A)') & 'get_values_for_time_span( instance', instance, & ', exchange_item_id: ', exchange_item_id, ', bc_index: ', bc_index , & ', layer_index: ', layer_index , & @@ -2391,7 +2394,7 @@ function m_openda_wrapper_set_values_for_time_span_(instance, exchange_item_id, exchange_item_id, ' not configured in EFDC.' else last_index = end_index-start_index+1 - write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I4,A)') & + write(dm_outfile_handle(instance),'(A,I4,A,I4,A,I4,A,F8.2,A,F8.2,A,I8,A)') & 'set_values_for_time_span( instance', instance, & ', exchange_item_id: ', exchange_item_id, ', bc_index: ', bc_index , & ', start_time: ', start_time, ', end_time: ', end_time, ', values_count: ', values_count ,'):' diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for index ff1d0c423..e5c4b0bb5 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/READWIMS1.for @@ -131,7 +131,7 @@ C 8997 FORMAT('LOADING TIME :',2X,I4,'.',I2,'/',I2,'.',I2,':',I2) 8995 FORMAT('LOADING PERIOD [MIN] :',I4) 8994 FORMAT('LOADING MASS [g] :',F12.3) ! 2010.12.8 - 8993 FORMAT('LOADING RATE [KG/S] :',F7.3) + 8993 FORMAT('LOADING RATE [KG/S] :',F8.3) IF(IDTOX.GE.4440.AND.MYRANK.EQ.0)THEN ! ONLY FOR OIL MODULE(CWCHO 101101) ! [CWCHO, 101203] From 3320ef8f8d407cbcba059614367442035051ee01 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:12:01 +0100 Subject: [PATCH 52/77] Correct nr of args to CALFQC --- .../native/efdc_fortran_dll/original_efdc_files/CALTRAN.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index 4652f514c..af8b61208 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -85,7 +85,7 @@ C C C ** CALCULATED EXTERNAL SOURCES AND SINKS C - CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1)!,FQCPAD,QSUMPAD,QSUMNAD) + CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1, FQCPAD,QSUMPAD,QSUMNAD) C C ** SELECT TRANSPORT OPTION, ISPLIT=1 FOR HORIZONTAL-VERTICAL C ** OPERATOR SPLITTING From 595e60cd2dc106ca8df8f7d7f71ba540e31f2660 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:14:41 +0100 Subject: [PATCH 53/77] Fix merge regression --- .../original_efdc_files/RESTOUT.for | 57 ++++++++++++------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for index bd4326d70..c92f7f168 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RESTOUT.for @@ -472,29 +472,48 @@ C call collect_in_zero(SUBO) call collect_in_zero(SVBO) ENDIF -C +C IF(MYRANK.EQ.0)THEN IF(ISWAVE.GE.1)THEN OPEN(1,FILE='WVQWCP.OUT',STATUS='UNKNOWN') - CLOSE(1, STATUS='DELETE') - OPEN(1,FILE='TEMP.RSTO',STATUS='UNKNOWN') - DO L=2,LA - WRITE(1,912)L,IL(L),JL(L),(TEM(L,K),K=1,KC),TEMB(L) - ENDDO - CLOSE(1) - ENDIF - IF(ISDRY.EQ.99)THEN - OPEN(1,FILE='RSTWD.OUT',STATUS='UNKNOWN') - CLOSE(1, STATUS='DELETE') - OPEN(1,FILE='RSTWD.OUT',STATUS='UNKNOWN') - DO L=2,LA - WRITE(1,913)L,IL(L),JL(L),ISCDRY(L),NATDRY(L), - & IMASKDRY(L),SUB(L),SVB(L),SUBO(L),SVBO(L) - ENDDO - CLOSE(1) - ENDIF + CLOSE(1, STATUS='DELETE') + OPEN(1,FILE='WVQWCP.OUT',STATUS='UNKNOWN') + DO L=2,LA + WRITE(1,911)IL(L),JL(L),QQWV1(L),QQWV2(L),QQWV3(L),QQWC(L), + & QQWCR(L),QQ(L,0) + ENDDO + CLOSE(1) ENDIF -C + IF(ISCO(1).GE.1.AND.ISTRAN(1).GT.0)THEN + OPEN(1,FILE='SALT.RST',STATUS='UNKNOWN') + CLOSE(1, STATUS='DELETE') + OPEN(1,FILE='SALT.RST',STATUS='UNKNOWN') + DO L=2,LA + WRITE(1,912)L,IL(L),JL(L),(SAL(L,K),K=1,KC) + ENDDO + CLOSE(1) + ENDIF + IF(ISCO(2).GE.1.AND.ISTRAN(2).GT.0)THEN + OPEN(1,FILE='TEMP.RST',STATUS='UNKNOWN') + CLOSE(1, STATUS='DELETE') + OPEN(1,FILE='TEMP.RSTO',STATUS='UNKNOWN') + DO L=2,LA + WRITE(1,912)L,IL(L),JL(L),(TEM(L,K),K=1,KC),TEMB(L) + ENDDO + CLOSE(1) + ENDIF + IF(ISDRY.EQ.99)THEN + OPEN(1,FILE='RSTWD.OUT',STATUS='UNKNOWN') + CLOSE(1, STATUS='DELETE') + OPEN(1,FILE='RSTWD.OUT',STATUS='UNKNOWN') + DO L=2,LA + WRITE(1,913)L,IL(L),JL(L),ISCDRY(L),NATDRY(L), + & IMASKDRY(L),SUB(L),SVB(L),SUBO(L),SVBO(L) + ENDDO + CLOSE(1) + ENDIF + ENDIF +C C ** OUTPUT SALINITY AND TEMPATURE DATA ASSIMILATION C CGEO if(myrank.eq.0)THEN From 102f8f878b15882a1a2f74d306d4d174e89372ce Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:17:36 +0100 Subject: [PATCH 54/77] Remove duplicate code after merge --- .../original_efdc_files/RWQC1.for | 38 ------------------- 1 file changed, 38 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index 383ca6646..4d1d1aebe 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -2489,44 +2489,6 @@ C INITIALIZE ENDIF ENDIF -!{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 - if (IWQDGSTOX.eq.1) then - PRINT *,'WQ: READING WQDGSTOX.INP - DG Salt TOX Control' - write(2,*) - write(2,*) - write(2,*) - write(2,'(a)') '===============Check WQDGSTOX.INP==============' - OPEN(1,FILE='WQDGSTOX.INP',STATUS='OLD') -! *** C01 WQDGSTOX.INP - ISSKIP = 0 - READ(1,'(A1)') CCMRM - BACKSPACE(1) - IF(CCMRM .EQ. '#') ISSKIP = 1 - CCMRM = '#' - IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) - READ(1,*) WQCOEFSA(1),WQCOEFSB(1),WQSALA(1),WQSALB(1) - READ(1,*) WQCOEFSA(2),WQCOEFSB(2),WQSALA(2),WQSALB(2) - WRITE(2,*) WQCOEFSA(1),WQCOEFSB(1),WQSALA(1),WQSALB(1) - WRITE(2,*) WQCOEFSA(2),WQCOEFSB(2),WQSALA(2),WQSALB(2) - IF (NXSP.gt.0) then - allocate(WQCOEFSAX(NXSP)) - allocate(WQCOEFSBX(NXSP)) - allocate(WQSALAX(NXSP)) - allocate(WQSALBX(NXSP)) -! -! *** C02 WQDGSTOX.INP -! - IF(ISSKIP .GT. 0) CALL SKIPCOMM(1,CCMRM) - IF(ISSKIP .EQ. 0) READ(1,*) - do i=1,NXSP - READ(1,*) WQCOEFSAX(i),WQCOEFSBX(i),WQSALAX(i),WQSALBX(i) - WRITE(2,*) i,WQCOEFSAX(i),WQCOEFSBX(i),WQSALAX(i),WQSALBX(i) - enddo - ENDIF - CLOSE(1) - endif -!} GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 - !{ GeoSR Diatom, Green algae Salinity TOX : jgcho 2019.11.27 if (IWQDGSTOX.eq.1) then IF(MYRANK.EQ.0)THEN From d201f0a4fd22cc088a1f5874bb65e08bfbb95755 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:18:23 +0100 Subject: [PATCH 55/77] Remove duplicat code after merge --- .../native/efdc_fortran_dll/original_efdc_files/HDMT2T.for | 2 -- 1 file changed, 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for index 72055d259..55b5cd256 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T.for @@ -1255,8 +1255,6 @@ C C ** CALCULATE U AT V AND V AT U AT TIME LEVEL (N+1) C C----------------------------------------------------------------------C -C - STIME=MPI_TIC() !!### WT_NLEVEL C DO L=2,LA LN=LNC(L) From 4744a01a054946c71be4f5b44ce3a80249fd623e Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 22 Jan 2024 13:21:45 +0100 Subject: [PATCH 56/77] Add MPI to linker --- .../native/efdc_fortran_dll/EfdcFortranDLL.vfproj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index acd80902f..539ca477f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -6,8 +6,8 @@ - - + + @@ -101,7 +101,7 @@ - + From ebd899065b460b298d54f0a7d1d86e3262c5e4fd Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:26:07 +0200 Subject: [PATCH 57/77] Add fixes for solar radiation --- .../original_efdc_files/WQ3D_mpi.for | 100 +++++++++++------- 1 file changed, 64 insertions(+), 36 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for index 0d99b065f..51f9acbc3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/WQ3D_mpi.for @@ -60,7 +60,8 @@ C Merged SNL and DS-INTL M1 = 0 M2 = 0 SUNSOL1 = 0.0 - DO WHILE (TASER(M,1).LT.SUNDAY2+0.5) + DO WHILE (TASER(M,1).LT. + + min(SUNDAY2+0.5,TASER(ubound(TASER,1),1))) M1 = M1+1 IF(SOLSWR(M,1).GT.0.)THEN M2 = M2+1 @@ -75,11 +76,17 @@ C Merged SNL and DS-INTL SUNFRC1=1.0 ENDIF +!{ Geosr, jgcho, 2015.5.29 solswr + IF (M.ge.ubound(TASER,1)) then + SUNSOL2=SUNSOL1 + SUNFRC2=SUNFRC1 + ELSE ! IF (M.gt.ubound(TASER,1)) then ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION M1 = 0 M2 = 0 SUNSOL2 = 0. - DO WHILE (TASER(M,1).LT.SUNDAY2+1.5) + DO WHILE (TASER(M,1).LT. + + min(SUNDAY2+1.5,TASER(ubound(TASER,1),1))) M1 = M1+1 IF(SOLSWR(M,1).GT.0.)THEN M2 = M2+1 @@ -93,6 +100,8 @@ C Merged SNL and DS-INTL ELSE SUNFRC2=1. ENDIF + ENDIF ! IF (M.gt.ubound(TASER,1)) then +!} Geosr, jgcho, 2015.5.29 solswr ENDIF !{ GeoSR, YSSONG. 2012/12/15, RESTART IF(ITNWQ.EQ.0)THEN @@ -106,23 +115,30 @@ C Merged SNL and DS-INTL M1 = 0 M2 = 0 SUNSOL0 = 0. +!{ Geosr, jgcho, 2015.5.29 solswr + IF(TASER(M,1).LE.DAYNEXT-(FLOAT(NDUM))) Then ! DO WHILE (TASER(M,1).LT.SUNDAY2-0.5) - DO WHILE (TASER(M,1).LT.DAYNEXT-(FLOAT(NDUM))+1.0) - IF(TASER(M,1).GE.DAYNEXT-(FLOAT(NDUM)))THEN - M1 = M1+1 - IF(SOLSWR(M,1).GT.0.)THEN - M2 = M2+1 - SUNSOL0=SUNSOL0+SOLSWR(M,1) !!! 1 day average - ENDIF - M = M+1 - ENDIF - END DO - IF(M1.GT.0)THEN - SUNFRC0=FLOAT(M2)/FLOAT(M1) - SUNSOL0=SUNSOL0/FLOAT(M1) !!! avg SUNSOL for timeday - ELSE - SUNFRC0=1.0 - ENDIF + DO WHILE (TASER(M,1).LT.DAYNEXT-(FLOAT(NDUM))+1.0) + IF(TASER(M,1).GE.DAYNEXT-(FLOAT(NDUM)))THEN + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL0=SUNSOL0+SOLSWR(M,1) !!! 1 day average + ENDIF + M = M+1 + ENDIF + END DO + IF(M1.GT.0)THEN + SUNFRC0=FLOAT(M2)/FLOAT(M1) + SUNSOL0=SUNSOL0/FLOAT(M1) !!! avg SUNSOL for timeday + ELSE + SUNFRC0=1.0 + ENDIF + ELSE ! IF(TASER(M,1).LE.DAYNEXT-(FLOAT(NDUM))) Then + SUNFRC0=SUNFRC1 + SUNSOL0=SUNSOL1 + ENDIF ! IF(TASER(M,1).LE.DAYNEXT-(FLOAT(NDUM))) Then +!} Geosr, jgcho, 2015.5.29 solswr IF(NDUM.EQ.2)THEN ! PREVIOUS DAY SUNSOL11=SUNSOL0 SUNFRC11=SUNFRC0 @@ -383,27 +399,39 @@ C SUNDAY1 = SUNDAY2 SUNSOL1 = SUNSOL2 SUNFRC1 = SUNFRC2 - - ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION - M1 = 0 - M2 = 0 - SUNSOL2 = 0. - SUNDAY2 = SUNDAY2+1. - DO WHILE (TASER(M,1).LT.SUNDAY2+0.5) - M1 = M1+1 - IF(SOLSWR(M,1).GT.0.)THEN - M2 = M2+1 - SUNSOL2=SUNSOL2+SOLSWR(M,1) - ENDIF +!{ Geosr, jgcho, 2015.5.29 solswr + ! *** FIND 1ST POINT + M = 1 + DO WHILE (TASER(M,1).LT.(SUNDAY2+0.5-EPS)) M = M+1 END DO - IF(M1.GT.0)THEN - SUNFRC2=FLOAT(M2)/FLOAT(M1) - SUNSOL2=SUNSOL2/FLOAT(M1) - ELSE - SUNFRC2=1. + SUNDAY2 = SUNDAY2+1 + ! If date for next day is not provided use values of today + IF( M.ge.ubound(TASER,1) ) then + SUNSOL2=SUNSOL1 + SUNFRC2=SUNFRC1 + ELSE ! IF (M.gt.ubound(TASER,1)) then + ! *** BUILD THE AVERAGE DAILY SOLAR RADIATION + M1 = 0 + M2 = 0 + SUNSOL2 = 0. + DO WHILE (TASER(M,1).LT. + + min(SUNDAY2+0.5-EPS, TASER(ubound(TASER,1),1)) ) + M1 = M1+1 + IF(SOLSWR(M,1).GT.0.)THEN + M2 = M2+1 + SUNSOL2=SUNSOL2+SOLSWR(M,1) + ENDIF + M = M+1 + END DO + IF(M1.GT.0)THEN + SUNFRC2=FLOAT(M2)/FLOAT(M1) + SUNSOL2=SUNSOL2/FLOAT(M1) + ELSE + SUNFRC2=1. + ENDIF ENDIF - +!} Geosr, jgcho, 2015.5.29 SOLSWR ENDIF ENDIF MPI_WTIMES(712)=MPI_WTIMES(712)+MPI_TOC(S1TIME) From fd12727307919a6b6d68fe240059073d8e0ebfc8 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:27:58 +0200 Subject: [PATCH 58/77] Initializi variables to zero --- .../native/efdc_fortran_dll/original_efdc_files/CALHEAT.for | 6 ++++++ .../efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for | 2 ++ .../efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 | 1 + 3 files changed, 9 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index 502ff16e6..30e293df3 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -89,10 +89,12 @@ C REAL TSSS_ABOVE REAL POMS_ABOVE REAL EXPBOT + REAL CSHE WQCHLS_ABOVE = 0.0 TSSS_ABOVE = 0.0 POMS_ABOVE = 0.0 EXPBOT = 0.0 + CSHE = 0.0 C IF(.NOT.ALLOCATED(NETRAD))THEN ALLOCATE(NETRAD(LCM,KCM)) @@ -702,6 +704,7 @@ C 600 FORMAT(4I5,2E12.4) TDEW_F = DEG_F(TDEW) TAIR_F = DEG_F(TAIR) WIND_MPH = WSPD*MPS_TO_MPH + print*, 'WIND', WIND_MPH, WINDH, MPS_TO_MPH WIND_2M = WIND_MPH*(LOG(2.0/0.003)/LOG(WINDH/0.003)) ******* Shortwave Radiation @@ -751,8 +754,11 @@ C 600 FORMAT(4I5,2E12.4) ET = TDEW_F TSTAR = (ET+TDEW_F)*0.5 BETA = 0.255-(8.5E-3*TSTAR)+(2.04E-4*TSTAR*TSTAR) + print*, 'EQUILIBRIUM_TEMPERATURE', W_M2_TO_BTU_FT2_DAY, AFW, + & BCONV, BFW, WIND_2M, CFW FW = W_M2_TO_BTU_FT2_DAY*AFW+BCONV*BFW*WIND_2M**CFW CSHE = 15.7+(0.26+BETA)*FW + print*, 'EQUILIBRIUM_TEMPERATURE', CSHE, BETA, FW RA = 3.1872E-08*(TAIR_F+459.67)**4 ETP = (SRO_BR+RA-1801.0)/CSHE+(CSHE-15.7) . *(0.26*TAIR_F+BETA*TDEW_F)/(CSHE*(0.26+BETA)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for index ff411baaf..349e98d28 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for @@ -90,9 +90,11 @@ C REAL TSSS_ABOVE REAL WQCHLS_ABOVE REAL POMS_ABOVE + REAL CSHE TSSS_ABOVE=0.0 WQCHLS_ABOVE=0.0 POMS_ABOVE=0.0 + CSHE=0.0 C IF(.NOT.ALLOCATED(NETRAD))THEN ALLOCATE(NETRAD(LCM,KCM)) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 index 526880a85..6fba8b4aa 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 @@ -1288,6 +1288,7 @@ SUBROUTINE VARZEROReal WC=0.0 WC2=0.0 WINDD=0.0 + WINDH=0.0 WINDS=0.0 WINDST=0.0 WINDSTKA=0.0 From 9e4e47f17c012d8573a5756dde693af8f91b1768 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:45:21 +0200 Subject: [PATCH 59/77] Add check if file exists before delete --- .../efdc_fortran_dll/original_efdc_files/EEXPOUT.for | 7 +++++++ .../efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for | 5 +++++ .../original_efdc_files/EEXPOUT_opt_mpi.for | 5 +++++ 3 files changed, 17 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT.for index d8bffe664..5ca9d59ae 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT.for @@ -28,6 +28,8 @@ INTEGER NP1 INTEGER COUNTCELL(LA) + LOGICAL FILE_EXISTS + SAVE IWQ SAVE NSEDSTEPS @@ -62,9 +64,14 @@ C ** INITIAL CALL IF(JSEXPLORER.EQ.1)THEN + + ! Check if the file exists + inquire(file='EE_WC.OUT', exist=FILE_EXISTS) + if (FILE_EXISTS) then OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') CLOSE(95,STATUS='DELETE') + end if OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') VER=106 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for index 40c846247..48a019413 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_mpi.for @@ -32,6 +32,8 @@ SAVE IWQ SAVE NSEDSTEPS + LOGICAL FILE_EXISTS + IF(ISDYNSTP.EQ.0)THEN DELT=DT ELSE @@ -235,9 +237,12 @@ C ** INITIAL CALL S1TIME=MPI_TIC() IF(JSEXPLORER.EQ.1.AND.MYRANK.EQ.0)THEN + inquire(file='EE_WC.OUT', exist=file_exists) + if (file_exists) then OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') CLOSE(95,STATUS='DELETE') + end if OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') VER=106 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for index 5f683d0f3..6cd1f3103 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/EEXPOUT_opt_mpi.for @@ -33,6 +33,8 @@ c INTEGER N1_1D(LCM) INTEGER NP1 INTEGER COUNTCELL(LA) + LOGICAL FILE_EXISTS + SAVE IWQ SAVE NSEDSTEPS @@ -252,9 +254,12 @@ c INTEGER N1_1D(LCM) C ** INITIAL CALL S1TIME=MPI_TIC() IF(JSEXPLORER.EQ.1.AND.MYRANK.EQ.0)THEN + inquire(file='EE_WC.OUT', exist=file_exists) + if (file_exists) then OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') CLOSE(95,STATUS='DELETE') + end if OPEN(95,FILE='EE_WC.OUT',STATUS='UNKNOWN', & ACCESS='SEQUENTIAL',FORM='UNFORMATTED') VER=106 From 9034bb36e6a649ec0e37d778a896452c30445bd6 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:45:52 +0200 Subject: [PATCH 60/77] Pass correct number of arguments --- .../native/efdc_fortran_dll/original_efdc_files/CALTRAN.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for index af8b61208..f33650271 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALTRAN.for @@ -85,7 +85,7 @@ C C C ** CALCULATED EXTERNAL SOURCES AND SINKS C - CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1, FQCPAD,QSUMPAD,QSUMNAD) + CALL CALFQC (ISTL_,IS2TL_,MVAR,M,CON,CON1)!,FQCPAD,QSUMPAD,QSUMNAD) C C ** SELECT TRANSPORT OPTION, ISPLIT=1 FOR HORIZONTAL-VERTICAL C ** OPERATOR SPLITTING From 6c9efecc63dc7307d7f4997224652779eb78a69c Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:46:33 +0200 Subject: [PATCH 61/77] Fix format specifier for debug logging --- .../native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 index 928b8fef8..0c58506fd 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 @@ -886,7 +886,7 @@ function m_openda_wrapper_compute_(instance, from_time_stamp, to_time_stamp)& TBEGIN = state(instance)%tbegin TIMESEC = state(instance)%timesec TIMEDAY = TIMESEC/86400.0 - if (debug) write(dm_outfile_handle(instance), '(A, F8.3, A, I5)' ) & + if (debug) write(dm_outfile_handle(instance), '(A, F9.3, A, I5)' ) & "Integrating over [s] ", time_period, " #steps", nint(time_period/dt) call model_make_step(time_period) state(instance)%timesec = TIMESEC From c69aea28f129a6f6fd8d3c38a241d38dc0a94a79 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:46:48 +0200 Subject: [PATCH 62/77] Fix typo --- .../native/efdc_fortran_dll/original_efdc_files/RWQC1.for | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for index 4d1d1aebe..55940a6b7 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/RWQC1.for @@ -377,7 +377,7 @@ C IF(MYRANK.EQ.0)THEN WRITE(2,*) WQKHNC,WQKHND,WQKHNG,WQKHNM,WQKHPC,WQKHPD,WQKHPG, & WQKHPM,WQKHS,WQSTOX - WRITE(2,80)'* HALF-SAT. COSNTANT (G/M^3) FOR NUTRIENT UPTAKE ' + WRITE(2,80)'* HALF-SAT. CONSTANT (G/M^3) FOR NUTRIENT UPTAKE ' WRITE(2,81)' : (KHNC, KHPC) = ', WQKHNC,WQKHPC WRITE(2,81)' : (KHND, KHPD, KHS) = ', WQKHND,WQKHPD,WQKHS WRITE(2,81)' : (KHNG, KHPG) = ', WQKHND,WQKHPG @@ -1974,7 +1974,7 @@ C 99 FORMAT(7F8.4, /, 7F8.4, /, 8F8.4) READ(1,*) WQKHNX(i),WQKHPX(i),WQKHSX(i),WQSTOXX(i) IF(MYRANK.EQ.0)THEN WRITE(2,*) i,WQKHNX(i),WQKHPX(i),WQKHSX(i),WQSTOXX(i) - WRITE(2,80)'* HALF-SAT. COSNTANT (G/M^3) FOR NUTRIENT UPTAKE ' + WRITE(2,80)'* HALF-SAT. CONSTANT (G/M^3) FOR NUTRIENT UPTAKE ' WRITE(2,81)' : (KHNX, KHPX) = ', WQKHNX(i),WQKHPX(i) WRITE(2,81)' : (KHS) = ', WQKHSX(i) WRITE(2,82)'* SAL. WHERE MICROSYSTIS GROWTH IS HALVED = ', From 9cf736aab6eeb4bbea904795e30485aa5e9929d3 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 11:48:17 +0200 Subject: [PATCH 63/77] Stop calculation on NaN temperatures --- .../efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for index c6ad589df..b4e965da8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for @@ -1228,7 +1228,12 @@ C ENDDO ENDDO ENDIF - IF(LTEST)CLOSE(1,STATUS='KEEP') + IF(LTEST) then + CLOSE(1,STATUS='KEEP') + PRINT*, "NaN Temperatures" + STOP + END IF + MPI_WTIMES(574)=MPI_WTIMES(574)+MPI_TOC(S1TIME) !{ GEOSR 2012.8.30 jgcho From f870fefd8a5326d519f5c3cef8904ced793c7f19 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 12:50:57 +0200 Subject: [PATCH 64/77] Update documentation --- model_efdc_dll/documentation.md | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/model_efdc_dll/documentation.md b/model_efdc_dll/documentation.md index 0a008f298..cfc6720a7 100644 --- a/model_efdc_dll/documentation.md +++ b/model_efdc_dll/documentation.md @@ -57,14 +57,27 @@ C73 ISVPH NPVPH ISRVPH IVPHXY ## Restart files -Input +| Input | Output | +| ------ | ---- | +| RESTART.INP | RESTART.OUT | +| RSTWD.INP | RSTWD.OUT | +| TEMP.RST | TEMP.RSTO | +| WQWCRST.INP | TEMP.RSTO | + +## Run time period + +| Template file | EFDC file | Keyword | +| -------------------------- | ------------------------ | ---- | +| `EFDC_TEMPLATE.INP` |`EFDC.INP` | `C7` `$N_REF_PERIODS$` | +| `EFDC_TEMPLATE.INP` | `EFDC.INP` | `C8` `$RELATIVE_TSTART$` (`TCON` must be 86400) | +| `TOX_EVENT2_TEMPLATE.INP` | `TOX_EVENT2.INP` | `$TSTART$` `$TSTOP$` | + +### Logging + +| File | Content | +| ----- | ------- | +| `model.log` | Initialisation of dll, displays exchange items supported by current EFDC configuration | +| `instance001.log` | Per instance log, logs data exchange with exchange item id for times and values, compute steps, etc. | -``` -RESTART.INP, RSTWD.INP, TEMP.RST, WQWCRST.INP -``` -Output -``` -RESTART.OUT, RSTWD.OUT, TEMP.RSTO, WQWCRST.OUT -``` \ No newline at end of file From 4b7bdddcbcce8479667d60ae39793db7c34ecc93 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Thu, 25 Apr 2024 12:52:13 +0200 Subject: [PATCH 65/77] Add gitignore --- model_efdc_dll/.gitignore | 10 ++++++++++ model_efdc_dll/native/efdc_fortran_dll/.gitignore | 1 + 2 files changed, 11 insertions(+) create mode 100644 model_efdc_dll/.gitignore create mode 100644 model_efdc_dll/native/efdc_fortran_dll/.gitignore diff --git a/model_efdc_dll/.gitignore b/model_efdc_dll/.gitignore new file mode 100644 index 000000000..ad1c781f2 --- /dev/null +++ b/model_efdc_dll/.gitignore @@ -0,0 +1,10 @@ +*genmod.* +*.obj +*.mod +*.lib +*.exp +*.u2d +*.pdb +*.manifest* + +BuildLog.htm diff --git a/model_efdc_dll/native/efdc_fortran_dll/.gitignore b/model_efdc_dll/native/efdc_fortran_dll/.gitignore new file mode 100644 index 000000000..f49fd16f3 --- /dev/null +++ b/model_efdc_dll/native/efdc_fortran_dll/.gitignore @@ -0,0 +1 @@ +x64/ \ No newline at end of file From da64fb2468f34ab4d1a5244600cddf0839d7a026 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Wed, 22 May 2024 13:43:44 +0200 Subject: [PATCH 66/77] Remove debug output --- .../native/efdc_fortran_dll/original_efdc_files/CALHEAT.for | 4 ---- 1 file changed, 4 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index 30e293df3..b8a4abc95 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -704,7 +704,6 @@ C 600 FORMAT(4I5,2E12.4) TDEW_F = DEG_F(TDEW) TAIR_F = DEG_F(TAIR) WIND_MPH = WSPD*MPS_TO_MPH - print*, 'WIND', WIND_MPH, WINDH, MPS_TO_MPH WIND_2M = WIND_MPH*(LOG(2.0/0.003)/LOG(WINDH/0.003)) ******* Shortwave Radiation @@ -754,11 +753,8 @@ C 600 FORMAT(4I5,2E12.4) ET = TDEW_F TSTAR = (ET+TDEW_F)*0.5 BETA = 0.255-(8.5E-3*TSTAR)+(2.04E-4*TSTAR*TSTAR) - print*, 'EQUILIBRIUM_TEMPERATURE', W_M2_TO_BTU_FT2_DAY, AFW, - & BCONV, BFW, WIND_2M, CFW FW = W_M2_TO_BTU_FT2_DAY*AFW+BCONV*BFW*WIND_2M**CFW CSHE = 15.7+(0.26+BETA)*FW - print*, 'EQUILIBRIUM_TEMPERATURE', CSHE, BETA, FW RA = 3.1872E-08*(TAIR_F+459.67)**4 ETP = (SRO_BR+RA-1801.0)/CSHE+(CSHE-15.7) . *(0.26*TAIR_F+BETA*TDEW_F)/(CSHE*(0.26+BETA)) From 66d01fe80190f9d49441547a2c75c0d789bed02a Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Wed, 22 May 2024 13:44:11 +0200 Subject: [PATCH 67/77] Add error message when using DLL with multiple MPI processes --- .../native/efdc_fortran_dll/original_efdc_files/MPI.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 index c4112af8c..e52986f71 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/MPI.f90 @@ -41,6 +41,11 @@ SUBROUTINE MPI_INITIALIZE CALL MPI_INIT(IERR) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR) CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR) + + IF (NPROCS > 1) THEN + PRINT*, 'EFDC library does not support running with multiple MPI processes' + STOP + END IF !$OMP PARALLEL OMPNUM=OMP_GET_MAX_THREADS() From 562335242916a2cd0ea790879ed1a86df4272d26 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Wed, 22 May 2024 13:47:10 +0200 Subject: [PATCH 68/77] Disable wrapper debug output --- .../native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 index 0c58506fd..75396db4c 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/openDA_wrapper.F90 @@ -82,7 +82,7 @@ module m_openda_wrapper integer :: dm_model_instance_count = 0 ! actual #instance integer :: dm_model_instance_in_memory = 0 ! index of the instance currenty in memory - logical, parameter :: debug = .true. + logical, parameter :: debug = .false. logical :: ATM_WARNING_REQUIRED = .true. contains From 7b6406bcda000bd6eb6e748f8ae7a40a23d9e132 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 10:13:22 +0200 Subject: [PATCH 69/77] Add implicit none and fix bug for dry cells --- .../original_efdc_files/CALPUV2C.for | 42 +++++++++++++++---- .../original_efdc_files/CALPUV2C_mpi.for | 35 +++++++++++++++- 2 files changed, 68 insertions(+), 9 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for index bfabd6b27..8af668c04 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C.for @@ -18,14 +18,42 @@ C ** SUBROUTINE CALPUV2TC CALCULATES THE EXTERNAL SOLUTION FOR P, UHDYE, C ** AND VHDXE, FOR FREE SURFACE FLOWS WITH PROVISIONS FOR WETTING C ** AND DRYING OF CELLS C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE + INTEGER::K,L,IACTALL + INTEGER::LL,NTMP,LS,LN + INTEGER::IUE,IUW,IVN,IVS + INTEGER::ICHNU,JCHNU + INTEGER::IHOST,JHOST,LHOST + INTEGER::IFACE + INTEGER::ICHNV,JCHNV + INTEGER::LCHNU,LCHNV + INTEGER::IVAL + INTEGER::ITERHP + INTEGER::ICORDRY,NCORDRY,NEWDRY + INTEGER::NMD + INTEGER::IMIN,IMAX,JMIN,JMAX + REAL::C1,CCMNM,CCMNMI + REAL::SUBE,SUBW + REAL::HDRY2,RDRY + REAL::TMPVAL + REAL::SVBS,SVBN,SVPW + REAL::RLAMN,RLAMO + REAL::ETGWTMP,ETGWAVL + REAL::DELTD2,DTAGW,DHPDT + REAL::QSUMIET,QEAVAIL,RAVAIL,RIFTRL + REAL::DIVEXMX,DIVEX,DIVEXMN,DIFQVOL + REAL::VOLADD + REAL::RVAL,RNPORI + REAL::BELVAVG + REAL::HOLDTMP,SURFTMP + REAL::SRFCHAN,SRFHOST,SRFCHAN1,SRFHOST1 INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IACTIVE INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IQDRYDWN REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANUT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANVT REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QSUMTMP - REAL,SAVE,ALLOCATABLE,DIMENSION(:)::DIFQVOL REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SUB1 REAL,SAVE,ALLOCATABLE,DIMENSION(:)::SVB1 INTEGER LMIN, LMAX @@ -37,7 +65,6 @@ C ALLOCATE(QCHANUT(NCHANM)) ALLOCATE(QCHANVT(NCHANM)) ALLOCATE(QSUMTMP(LCM)) - ALLOCATE(DIFQVOL(LCM)) ALLOCATE(SUB1(LCM)) ALLOCATE(SVB1(LCM)) IACTIVE=0 @@ -45,7 +72,6 @@ C QCHANUT=0. QCHANVT=0. QSUMTMP=0. - DIFQVOL=0. SUB1=0. SVB1=0. ENDIF @@ -287,7 +313,7 @@ C DO L=2,LA DIFQVOL=QSUME(L)-QSUMTMP(L) DO K=1,KC - QSUM(L,K)=QSUM(L,K)-DIFQVOL(L)*DZC(K) + QSUM(L,K)=QSUM(L,K)-DIFQVOL*DZC(K) ENDDO QSUME(L)=QSUMTMP(L) ENDDO @@ -361,7 +387,7 @@ C DO L=2,LA DIFQVOL=QSUME(L)-QSUMTMP(L) DO K=1,KC - QSUM(L,K)=QSUM(L,K)-DIFQVOL(L)*DZC(K) + QSUM(L,K)=QSUM(L,K)-DIFQVOL*DZC(K) ENDDO QSUME(L)=QSUMTMP(L) ENDDO @@ -795,7 +821,9 @@ C ICORDRY=1 ELSE TMPVAL=ABS(SVB(LN)-SVBN) - IF(TMPVAL.GT.0.5)THEN ICORDRY=1 + IF(TMPVAL.GT.0.5)THEN + ICORDRY=1 + ENDIF ENDIF ENDIF ENDIF diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for index c62819998..463f1d3bb 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPUV2C_mpi.for @@ -20,7 +20,36 @@ C ** AND DRYING OF CELLS C USE GLOBAL USE MPI - + IMPLICIT NONE + INTEGER::K,IACTALL + INTEGER::LL,NTMP,LS,LN + INTEGER::IUE,IUW,IVN,IVS + INTEGER::ICHNU,JCHNU + INTEGER::IHOST,JHOST,LHOST + INTEGER::IFACE + INTEGER::ICHNV,JCHNV + INTEGER::LCHNU,LCHNV + INTEGER::IVAL + INTEGER::ITERHP + INTEGER::ICORDRY,NCORDRY,NEWDRY + INTEGER::NMD + INTEGER::IMIN,IMAX,JMIN,JMAX + REAL::C1,CCMNM,CCMNMI + REAL::SUBE,SUBW + REAL::HDRY2,RDRY + REAL::TMPVAL + REAL::SVBS,SVBN,SVPW + REAL::RLAMN,RLAMO + REAL::ETGWTMP,ETGWAVL + REAL::DELTD2,DTAGW,DIFQVOL,DHPDT + REAL::QSUMIET,QEAVAIL,RAVAIL,RIFTRL + REAL::DIVEXMX,DIVEX,DIVEXMN + REAL::VOLADD + REAL::RVAL,RNPORI + REAL::BELVAVG + REAL::HOLDTMP,SURFTMP + REAL::SRFCHAN,SRFHOST,SRFCHAN1,SRFHOST1 + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IACTIVE INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)::IQDRYDWN REAL,SAVE,ALLOCATABLE,DIMENSION(:)::QCHANUT @@ -1051,7 +1080,9 @@ C ICORDRY=1 ELSE TMPVAL=ABS(SVB(LN)-SVBN) - IF(TMPVAL.GT.0.5)THEN ICORDRY=1 + IF(TMPVAL.GT.0.5)THEN + ICORDRY=1 + ENDIF ENDIF ENDIF ENDIF From 64d631edba8c727886d47a1accb861964c24e743 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 10:15:11 +0200 Subject: [PATCH 70/77] Correct initialization of reals --- .../original_efdc_files/VARZEROInt.f90 | 14 -------------- .../original_efdc_files/VARZEROReal.f90 | 15 +++++++++++++++ 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 index 6bcf9300f..dd8287fd2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROInt.f90 @@ -449,24 +449,10 @@ SUBROUTINE VARZEROInt TIME_NUM=0 IBIN_TYPE=0 - DZCB_2D =0 - BK_2D =0 - DBK_1D =0 - SHEAR_1D =0 - HBED_1D =0 - BDENBED_1D =0 - PORBED_1D =0 N1_1D =0 - CLOE_TMP =0 - CLON_TMP =0 - CLOS_TMP =0 - CLOW_TMP =0 NLOE_TMP =0 NLON_TMP =0 NLOS_TMP =0 NLOW_TMP =0 - CSERT_TMP =0 - CSERT_SUM =0 - END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 index 6fba8b4aa..46505053a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/VARZEROReal.f90 @@ -1749,6 +1749,21 @@ SUBROUTINE VARZEROReal LightAVG=0. LightAVG1=0. LightAVG0=0. + + CLOE_TMP =0. + CLON_TMP =0. + CLOS_TMP =0. + CLOW_TMP =0. + + CSERT_TMP =0. + CSERT_SUM =0. + DZCB_2D =0. + BK_2D =0. + DBK_1D =0. + SHEAR_1D =0. + HBED_1D =0. + BDENBED_1D =0. + PORBED_1D =0. END SUBROUTINE VARZEROReal From cc0eeb8e30ec89edfa6066cd9a352f3dd92714a5 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 10:16:05 +0200 Subject: [PATCH 71/77] Improve error message --- .../native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for index b4e965da8..0f246445d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/HDMT2T_mpi.for @@ -1230,7 +1230,7 @@ C ENDIF IF(LTEST) then CLOSE(1,STATUS='KEEP') - PRINT*, "NaN Temperatures" + PRINT*, "ERROR IN VARIABLES, CHECK ERROR.LOG" STOP END IF From c21ce8eedcf0db65ac11770cd0421bb890d247f4 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 10:18:00 +0200 Subject: [PATCH 72/77] Add implicit none and variable declarations --- .../original_efdc_files/CALFQC.for | 15 ++++-- .../original_efdc_files/CALFQC_mpi.for | 17 +++++-- .../original_efdc_files/CALHEAT.for | 51 ++++++++++++++++--- .../original_efdc_files/CALHEAT_mpi.for | 24 +++++++++ .../original_efdc_files/CALHTA.for | 16 +++++- .../original_efdc_files/CALIMP2T.for | 9 +++- .../original_efdc_files/CALMMT.for | 10 ++++ .../original_efdc_files/CALMMT_mpi.for | 11 ++++ .../original_efdc_files/CALPGCORR.for | 5 +- .../original_efdc_files/CALPNHS.for | 11 +++- .../original_efdc_files/CALPNHS_mpi.for | 11 +++- .../original_efdc_files/CALPSER.for | 9 +++- .../original_efdc_files/CALPSER_mpi.for | 7 +++ 13 files changed, 174 insertions(+), 22 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for index b51cda77e..412ad8f04 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC.for @@ -7,17 +7,24 @@ C ** WITH CONSTANT AND TIME SERIES INFLOWS AND OUTFLOWS; CONTROL C ** STRUCTURE INFLOWS AND OUTLOWS; WITHDRAWAL AND RETURN STRUCTURE C ** OUTFLOWS; AND EMBEDED CHANNEL INFLOWS AND OUTFLOWS C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE INTEGER::L,K,ID,JD,KD,NWR,IU,JU,KU,LU,NS INTEGER::LD,NMD,NJP - DIMENSION CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(0:LCM1,KCM), + INTEGER::M,MO,MVAR + INTEGER::ISTL_,IS2TL_ + INTEGER::NCTL,LJP,KTMP,NQSTMP,NCSTMP + INTEGER::LMDCHHT,LMDCHUT,LMDCHVT + + REAL::CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(0:LCM1,KCM), ! & QSUMNAD(0:LCM1,KCM),QSUMPAD(0:LCM1,KCM) REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ - REAL QVKTMP,QUKTMP - + REAL::QVKTMP,QUKTMP,QVJPTMP,QCJPTMP,QVJPENT + REAL::CONUP,RPORTS,RQWD + L = 0 QVKTMP = 0.0 QUKTMP = 0.0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for index 1d1b3cc6d..9d4820246 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALFQC_mpi.for @@ -9,16 +9,23 @@ C ** OUTFLOWS; AND EMBEDED CHANNEL INFLOWS AND OUTFLOWS C USE GLOBAL USE MPI - + IMPLICIT NONE + INTEGER::L,K,ID,JD,KD,NWR,IU,JU,KU,LU,NS INTEGER::LD,NMD,NJP - DIMENSION CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(LCM,KCM), + INTEGER::M,MO,MVAR + INTEGER::ISTL_,IS2TL_ + INTEGER::NCTL,LJP,KTMP,NQSTMP,NCSTMP + INTEGER::LMDCHHT,LMDCHUT,LMDCHVT + + REAL::CON(LCM,KCM),CON1(LCM,KCM)!,FQCPAD(LCM,KCM), ! & QSUMNAD(LCM,KCM),QSUMPAD(LCM,KCM) - REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ - REAL QVKTMP - REAL QUKTMP + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::CONQ + REAL::QVKTMP,QUKTMP,QVJPTMP,QCJPTMP,QVJPENT + REAL::CONUP,RPORTS,RQWD + QVKTMP=0.0 QUKTMP=0.0 L=0 diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for index b8a4abc95..fe9475c1e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT.for @@ -76,7 +76,30 @@ C CHANGE RECORD C ** SUBROUTINE CALHEAT CALCULATES SURFACE AND INTERNAL HEAT SOURCES C ** AND SINKS IN THE HEAT (TEM) TRANSPORT EQUATION C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE + + INTEGER::I,J,K,L,L1,IS,ND + INTEGER::LL,LF + INTEGER::ISTL_ + REAL::C1,C2 + REAL::RB,RC,RE,ET,FW + REAL::TMPVAL,TMPKC + REAL::USPD,UBED,VBED + REAL::CLDFAC + REAL::TFAST,TFAST1,TSLOW,TSLOW1 + REAL::T1,T2 + REAL::BOT,TOP,EXPTOP,EXPBOT + REAL::GAMMA + REAL::TIMTMP + REAL::NDUM + REAL::SHDAY,SHDDAY,PSHADE0,PSHADE_OLD,NDATASHD + REAL::SRO,SRON,SVPW + REAL::RAN,RSN + REAL::DTHEQT + REAL::THICK,TFLUX + REAL::TSS_ABOVE,WQCHL_ABOVE,POM_ABOVE + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::NETRAD REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TBEDTHK REAL,SAVE,ALLOCATABLE,DIMENSION(:)::HDEP @@ -88,7 +111,6 @@ C REAL WQCHLS_ABOVE REAL TSSS_ABOVE REAL POMS_ABOVE - REAL EXPBOT REAL CSHE WQCHLS_ABOVE = 0.0 TSSS_ABOVE = 0.0 @@ -637,11 +659,27 @@ C 600 FORMAT(4I5,2E12.4) SUBROUTINE HEAT_EXCHANGE USE GLOBAL + IMPLICIT NONE ******* Tupe declaration - REAL JDAY - INTEGER*4 IDAY + REAL JDAY + INTEGER*4 IDAY + INTEGER::J + REAL::ET,ETP + REAL::BETA + REAL::TAIR,TD,TD_C,TDEW,WIND_MPH,TSTAR + REAL::DEG_F,DEG_C + REAL::DECL,H + REAL::THOUR,PMC1,EQTNEW + REAL::X + REAL::VAPORP + REAL::CLD,CLD10 + REAL::STANDARD,SINAL + REAL::A0,ASIN + REAL::SRO,SRON,SRO_BR + + REAL::WSPD,ATMPR,FW,CSHE,RA,TA_C ******* Allocate/Dimension declaration @@ -652,7 +690,6 @@ C 600 FORMAT(4I5,2E12.4) Real, SAVE :: TDEW_F, TAIR_F, WIND_2M Real, SAVE :: TIMENEXT - ******* Data declaration DATA MPS_TO_MPH /2.23714/, @@ -675,7 +712,7 @@ C 600 FORMAT(4I5,2E12.4) ************************************************************************ ENTRY SHORT_WAVE_RADIATION(WSPD,TD,TAIR,CLD,ATMPR,SRO,SRON) - + ******* Input Conversions IF(TD.LT.1.1.AND.IRELH(NASER).EQ.1)THEN ! *** TD IS RELATIVE HUMIDITY. CONVERT TO DEW POINT @@ -742,7 +779,7 @@ C 600 FORMAT(4I5,2E12.4) ************************************************************************ ENTRY EQUILIBRIUM_TEMPERATURE(SRON,ET,CSHE) - + ******* British units ! *** SRON Should already be adjusted for Shading & Reflection diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for index 349e98d28..f45b32041 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHEAT_mpi.for @@ -78,6 +78,30 @@ C ** AND SINKS IN THE HEAT (TEM) TRANSPORT EQUATION C USE GLOBAL USE MPI + + IMPLICIT NONE + + INTEGER::I,J,K,L,L1,IS,ND + INTEGER::LL,LF + INTEGER::ISTL_ + REAL::C1,C2 + REAL::RB,RC,RE,ET,FW + REAL::TMPVAL,TMPKC + REAL::USPD,UBED,VBED + REAL::CLDFAC + REAL::TFAST,TFAST1,TSLOW,TSLOW1 + REAL::T1,T2 + REAL::BOT,TOP,EXPTOP,EXPBOT + REAL::GAMMA + REAL::TIMTMP + REAL::NDUM + REAL::SHDAY,SHDDAY,PSHADE0,PSHADE_OLD,NDATASHD + REAL::SRO,SRON,SVPW + REAL::RAN,RSN + REAL::DTHEQT + REAL::THICK,TFLUX + REAL::TSS_ABOVE,WQCHL_ABOVE,POM_ABOVE + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::NETRAD REAL,SAVE,ALLOCATABLE,DIMENSION(:)::TBEDTHK REAL,SAVE,ALLOCATABLE,DIMENSION(:)::HDEP diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for index 18ee02bd6..29916c277 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALHTA.for @@ -6,7 +6,21 @@ C ** OVER TWO TIDAL CYCLES C USE GLOBAL USE MPI - CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE4,TITLE11,TITLE12 + IMPLICIT NONE + CHARACTER*80 TITLE1,TITLE2,TITLE3,TITLE4,TITLE11,TITLE12 + INTEGER::L,K + INTEGER::LINES,LEVELS,LN + REAL::DBS,DBS1,DBS2 + REAL::UTMP,UTMP1,VTMP,VTMP1 + REAL::AMC,AMS + REAL::SSURFAMP,SSURFPHS,SSURFPSC + REAL::PHI + REAL::TERM1,TERM2,TERM3,TERM4 + REAL::RPLUS,RMINS,APLUS,AMINS + REAL::RRMIN,RRMAJ,RMAJUKB,RMAJVKB,RMAJUKC,RMAJVKC + REAL::AACCWX + REAL::PHASEKB,PHASEKC + C C ** INITIALIZE ON FIRST ENTRY FOR CURRENT ANALYSIS INTERVAL C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for index 7098ac506..e20a6211a 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALIMP2T.for @@ -4,7 +4,14 @@ C ** SUBROUTINE CALEXP CALCULATES IMPLICIT MOMENTUM EQUATION C ** CORIOLIS AND CURVATURE TERMS FOR 1/2 STEP PREDICTOR C CHANGE RECORD C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE + INTEGER::K,L,ND + INTEGER::LS,LN,LNW,LSE + INTEGER::LF,LL + REAL::TMPVAL + REAL::WVFACT,RCDZF,DELTD2 + IF(ISDYNSTP.EQ.0)THEN DELT=DT DELTD2=0.5*DT diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT.for index 5f95561da..7aed6142d 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT.for @@ -5,6 +5,16 @@ C ** SUBROUTINE CALMMTF CALCULATES THE MEAN MASS TRANSPORT FIELD C USE GLOBAL C + IMPLICIT NONE + + INTEGER::I,J,K,L,ITMP + INTEGER::NT,NS,NSN,NMD,NWR + INTEGER::LL + INTEGER::LS,LSW,LT,LN + REAL:: UTMP,UTMP1,VTMP,VTMP1 + REAL::HPLW,HPLS,HPLSW,HMC + REAL::TMPVAL,FLTWT + LOGICAL INITIALIZE DATA INITIALIZE/.TRUE./ C diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for index 2eb9d4c4d..47d514af2 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALMMT_mpi.for @@ -5,6 +5,17 @@ C ** SUBROUTINE CALMMTF CALCULATES THE MEAN MASS TRANSPORT FIELD C USE GLOBAL USE MPI + + IMPLICIT NONE + + INTEGER::I,J,K,L,ITMP + INTEGER::NT,NS,NSN,NMD,NWR + INTEGER::LL + INTEGER::LS,LSW,LT,LN + REAL:: UTMP,UTMP1,VTMP,VTMP1 + REAL::HPLW,HPLS,HPLSW,HMC + REAL::TMPVAL,FLTWT + C LOGICAL INITIALIZE DATA INITIALIZE/.TRUE./ diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPGCORR.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPGCORR.for index 8a7a343e1..3e88eb561 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPGCORR.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPGCORR.for @@ -12,7 +12,10 @@ C DATE MODIFIED BY DATE APPROVED BY C USE GLOBAL + IMPLICIT NONE INTEGER,SAVE::LASTCOR + INTEGER::L + REAL::RELAX, RATIO REAL, SAVE::BEGRELAX, ENDRELAX @@ -40,4 +43,4 @@ C ENDIF RETURN - END \ No newline at end of file + END diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS.for index bbbc2c039..cf3163a90 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS.for @@ -3,7 +3,16 @@ C C CHANGE RECORD C ** SUBROUTINE CALPNHS CALCULATES QUASI-NONHYDROSTATIC PRESSURE C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE + + INTEGER::L,K,LN,LS,NS + INTEGER::IU,JU,KU,LU + INTEGER::ID,JD,KD,LD + INTEGER::NWR + REAL:: UHUW,VHVW + REAL::WB,ADIFF,TMPVAL,TMPANG,DELTD2 + REAL::QMF,QUMF REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::PNHYDSS REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FWJET diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for index 63e084bc4..f2ef7534f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPNHS_mpi.for @@ -5,7 +5,16 @@ C ** SUBROUTINE CALPNHS CALCULATES QUASI-NONHYDROSTATIC PRESSURE C USE GLOBAL USE MPI - + IMPLICIT NONE + + INTEGER::L,K,LN,LS,NS + INTEGER::IU,JU,KU,LU + INTEGER::ID,JD,KD,LD + INTEGER::NWR + REAL:: UHUW,VHVW + REAL::WB,ADIFF,TMPVAL,TMPANG,DELTD2 + REAL::QMF,QUMF + REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::PNHYDSS REAL,SAVE,ALLOCATABLE,DIMENSION(:,:)::FWJET IF(.NOT.ALLOCATED(PNHYDSS))THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for index e3d98fe12..3dd963e7e 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER.for @@ -4,7 +4,14 @@ C CHANGE RECORD C ** SUBROUTINE CALPSER UPDATES TIME VARIABLE SURFACE ELEVATION C ** BOUNDARY CONDITIONS C - USE GLOBAL + USE GLOBAL + IMPLICIT NONE + INTEGER::ISTL_ + INTEGER::NS + INTEGER::M1,M2 + REAL::TDIFF,TIME + REAL::WTM1,WTM2 + PSERT(0)=0. DO NS=1,NPSER IF(ISDYNSTP.EQ.0)THEN diff --git a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for index c86db1c9a..cd3f2f19f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for +++ b/model_efdc_dll/native/efdc_fortran_dll/original_efdc_files/CALPSER_mpi.for @@ -6,6 +6,13 @@ C ** BOUNDARY CONDITIONS C USE GLOBAL USE MPI + IMPLICIT NONE + INTEGER::ISTL_ + INTEGER::NS + INTEGER::M1,M2 + REAL::TDIFF,TIME + REAL::WTM1,WTM2 + C S1TIME=MPI_TIC() C From f7d71f6a7a948c228693e02dbe2c3e36f4421221 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 10:18:57 +0200 Subject: [PATCH 73/77] Add new version of EFDC.for main file, used for reference only --- .../unused_efdc_files/EFDC.for | 106 +++++++++++------- 1 file changed, 67 insertions(+), 39 deletions(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/unused_efdc_files/EFDC.for b/model_efdc_dll/native/efdc_fortran_dll/unused_efdc_files/EFDC.for index 8848c3581..e70528304 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/unused_efdc_files/EFDC.for +++ b/model_efdc_dll/native/efdc_fortran_dll/unused_efdc_files/EFDC.for @@ -100,6 +100,7 @@ C ** GWATER.INP C C *** EE BEGIN BLOCK USE GLOBAL + USE MPI C C *** WASP7 Linkage CPMC COMMON/WASPHYDRO/ IHL_HANDLE,ibegin,idays,ad,adcoeff,abwmax,abwmx @@ -107,6 +108,7 @@ CPMC INCLUDE 'hydrolink_set.INT' CPMC CHARACTER*256 errstring C CHARACTER*80 TITLE + CHARACTER*10 MPI_ARG C REAL,ALLOCATABLE,DIMENSION(:,:)::SHOTS C @@ -117,8 +119,10 @@ C REAL*8 T1,T2,DELSNAP INTEGER COUNT LOGICAL PAUSEIT - CHARACTER*20 BUFFER + CHARACTER*20 BUFFER C + CALL MPI_INITIALIZE + ![ykchoi 10.04.26. for linux version ! INTERFACE TO INTEGER FUNCTION ATEXIT ! & [C,ALIAS:'_atexit'](FUN) @@ -143,33 +147,37 @@ C ! *** GET THE COMMAND LINE ARGUMENTS, IF ANY IF(COUNT.GT.0)THEN - CALL GETARG(1, BUFFER, iStatus) - IF (Buffer(1:4).EQ.'-NOP'.OR.Buffer(1:4).EQ.'-nop') THEN - PAUSEIT=.FALSE. - ENDIF +C CALL GETARG(1, BUFFER, iStatus) +C IF (Buffer(1:4).EQ.'-NOP'.OR.Buffer(1:4).EQ.'-nop') THEN +C PAUSEIT=.FALSE. +C ENDIF +C CALL GETARG(1, MPI_ARG) ENDIF + MPI_ARG='PARL' C C *** EE END BLOCK C - CALL WELCOME + IF(MYRANK.EQ.0) CALL WELCOME C IF(PAUSEIT)THEN - WRITE(*,'(A)')'SETTING EXCEPTION TRAPS(TAP SPACEBAR TO QUIT)' + IF(MYRANK.EQ.0) + & WRITE(*,'(A)')'SETTING EXCEPTION TRAPS(TAP SPACEBAR TO QUIT)' ![ykchoi 10.04.26. for linux version ! IF(ATEXIT(QUIT).NE.0)STOP'CAN''T TRAP EXCEPTIONS' !ykchoi] ENDIF C -C ** OPEN OUTPUT FILES +C ** OPEN OUTPUT FILES C + IF(MYRANK.EQ.0) THEN OPEN(7,FILE='EFDC.OUT',STATUS='UNKNOWN') - OPEN(8,FILE='EFDCLOG.OUT',STATUS='UNKNOWN') + OPEN(8,FILE='EFDCLOG.OUT',STATUS='UNKNOWN') OPEN(9,FILE='TIME.LOG',STATUS='UNKNOWN') CLOSE(7,STATUS='DELETE') CLOSE(8,STATUS='DELETE') CLOSE(9,STATUS='DELETE') OPEN(7,FILE='EFDC.OUT',STATUS='UNKNOWN') - write(7,*) 'Modified by GEOSR (NH014_161006_alg_stl_day)' !GEOSR 2016.10.06 jgcho + WRITE(7,*) 'Modified by GEO_YOON_JG MPI EFDC-NIER 210528' ! GEOSR 2021.05.28 jgcho OPEN(8,FILE='EFDCLOG.OUT',STATUS='UNKNOWN') OPEN(9,FILE='TIME.LOG',STATUS='UNKNOWN') @@ -185,12 +193,15 @@ C CLOSE(1,STATUS='DELETE') OPEN(1,FILE='ERROR.LOG',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') + ENDIF C C ** CALL INPUT SUBROUTINE C CALL VARINIT CALL INPUT(TITLE) C + CALL MPI_DECOMPOSITION +C C ** CALL SUBROUTINE TO ADJUST, CONVERT AND SMOOTH DEPTH FIELD C C IF(NSHMAX.GE.1) CALL DEPSMTH PMC @@ -351,7 +362,7 @@ C ! *** HIGH FREQUENCY SNAPSHOTS IF(ISPPH.EQ.100)THEN - PRINT *, 'HIGH FREQ SNAPSHOTS USED' + IF(MYRANK.EQ.0) PRINT *, 'HIGH FREQ SNAPSHOTS USED' NS=0 OPEN(1,FILE='SNAPSHOTS.INP',STATUS='UNKNOWN',ERR=999) DO NS=1,4 @@ -446,10 +457,10 @@ C ENDIF ENDDO ENDIF - PRINT *, 'NSNAPSHOTS=', NSNAPSHOTS - WRITE(7,*)'NSNAPSHOTS=', NSNAPSHOTS + IF(MYRANK.EQ.0) PRINT *, 'NSNAPSHOTS=', NSNAPSHOTS + IF(MYRANK.EQ.0) WRITE(7,*)'NSNAPSHOTS=', NSNAPSHOTS DO I=1,NSNAPSHOTS - WRITE(7,*)'SNAPSHOT: ',I,SNAPSHOTS(I) + IF(MYRANK.EQ.0) WRITE(7,*)'SNAPSHOT: ',I,SNAPSHOTS(I) ENDDO IF(NSNAPSHOTS.GT.2)THEN IF(SNAPSHOTS(NSNAPSHOTS).LT.T2)SNAPSHOTS(NSNAPSHOTS+1)=T2+.001 @@ -719,7 +730,7 @@ C WINDSTKA(L)=TMPVAL FCORC(L)=TMPCOR DETTMP=1./( CUE(L)*CVN(L)-CUN(L)*CVE(L) ) - IF(DETTMP.EQ.0.0)THEN + IF(DETTMP.EQ.0.0.AND.MYRANK.EQ.0)THEN WRITE(6,6262) WRITE(6,6263)IL(L),JL(L) STOP @@ -750,7 +761,7 @@ C WINDSTKA(L)=TMPVAL FCORC(L)=CF DETTMP=1./( CUE(L)*CVN(L)-CUN(L)*CVE(L) ) - IF(DETTMP.EQ.0.0)THEN + IF(DETTMP.EQ.0.0.AND.MYRANK.EQ.0)THEN WRITE(6,6262) WRITE(6,6263)IL(L),JL(L) STOP @@ -778,7 +789,7 @@ C *** DSLLC END BLOCK 3002 CONTINUE ZERO=0. - IF(DEBUG)THEN + IF(DEBUG.AND.MYRANK.EQ.0)THEN OPEN(1,FILE='LIJMAP.OUT',STATUS='UNKNOWN') DO L=2,LA WRITE(1,1113)L,IL(L),JL(L),ZERO @@ -869,7 +880,7 @@ C C C ** SET BOUNDARY CONDITION SWITCHES C - CALL SETBCS + CALL SETBCS_mpi C C ** CALCUATE CURVATURE METRICS (NEW ADDITION) C @@ -947,7 +958,7 @@ C IF(ISRESTI.EQ.2) CALL RESTIN2 IF(ISRESTI.EQ.10) CALL RESTIN10 ENDIF - IF(ISRESTI.EQ.-1) CALL RESTIN1 + IF(ISRESTI.EQ.-1) CALL RESTIN1 C C ** INTIALIZE SALINITY FIELD IF NOT READ IN FROM RESTART FILE C @@ -1781,9 +1792,11 @@ C C ** INITIALIZE ZERO DIMENSION VOLUME BALANCE C IF(ISDRY.GE.1.AND.ISDRY.LE.98)THEN + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='ZVOLBAL.OUT',STATUS='UNKNOWN') CLOSE(1,STATUS='DELETE') OPEN(1,FILE='AVSEL.OUT',STATUS='UNKNOWN') + ENDIF LPBTMP=0 DO L=2,LA TVAR3C(L)=0 @@ -1809,27 +1822,30 @@ C LORDER(LS)=LBELMIN TVAR3C(LBELMIN)=1 ENDDO - WRITE(1,5300) + IF(MYRANK.EQ.0) WRITE(1,5300) LS=1 L=LORDER(LS) BELSURF(LS)=BELV(L) ASURFEL(LS)=DXYP(L) VOLSEL(LS)=0. - WRITE(1,5301)LS,BELSURF(LS),ASURFEL(LS),VOLSEL(LS) + IF(MYRANK.EQ.0) WRITE(1,5301)LS,BELSURF(LS), + & ASURFEL(LS),VOLSEL(LS) DO LS=2,LORMAX L=LORDER(LS) BELSURF(LS)=BELV(L) ASURFEL(LS)=ASURFEL(LS-1)+DXYP(L) VOLSEL(LS)=VOLSEL(LS-1)+0.5*(BELSURF(LS)-BELSURF(LS-1))* & (ASURFEL(LS)+ASURFEL(LS-1)) - WRITE(1,5301)LS,BELSURF(LS),ASURFEL(LS),VOLSEL(LS) + IF(MYRANK.EQ.0) + & WRITE(1,5301)LS,BELSURF(LS),ASURFEL(LS),VOLSEL(LS) ENDDO LS=LORMAX+1 BELSURF(LS)=BELV(L)+10.0 ASURFEL(LS)=ASURFEL(LS-1) VOLSEL(LS)=VOLSEL(LS-1)+0.5*(BELSURF(LS)-BELSURF(LS-1))* & (ASURFEL(LS)+ASURFEL(LS-1)) - WRITE(1,5301)LS,BELSURF(LS),ASURFEL(LS),VOLSEL(LS) + IF(MYRANK.EQ.0) + & WRITE(1,5301)LS,BELSURF(LS),ASURFEL(LS),VOLSEL(LS) VOLZERD=0. VOLLDRY=0. DO L=2,LA @@ -1850,8 +1866,8 @@ C ENDIF ENDDO VETZERD=VOLZERD - WRITE(1,5302) - WRITE(1,5303) SELZERD,ASFZERD,VOLZERD,VOLLDRY + IF(MYRANK.EQ.0) WRITE(1,5302) + IF(MYRANK.EQ.0) WRITE(1,5303) SELZERD,ASFZERD,VOLZERD,VOLLDRY CLOSE(1) ENDIF 5300 FORMAT(' M BELSURF ASURFEL ', @@ -1878,7 +1894,8 @@ C DO L=2,LA AGWELV1(L)=AGWELV(L) AGWELV2(L)=AGWELV(L) - ENDDO + ENDDO + IF(MYRANK.EQ.0)THEN OPEN(1,FILE='GWELV.OUT',STATUS='UNKNOWN') WRITE(1,5400) WRITE(1,5402) @@ -1886,6 +1903,7 @@ C WRITE(1,5401)IL(L),JL(L),BELV(L),BELAGW(L),AGWELV(L) ENDDO CLOSE(1) + ENDIF ENDIF 5400 FORMAT(' I J BELELV BELAGW ', & ' AGWELV',/) @@ -1952,7 +1970,7 @@ C C ** SMOOTH INITIAL SALINITY C IF(NSBMAX.GE.1)THEN - CALL SALTSMTH + CALL SALTSMTH_mpi ENDIF C C ** OUTPUT INITIAL DEPTH AND SALINITY FIELDS @@ -1961,7 +1979,7 @@ C DO L=2,LA PAM(L)=HMP(L) ENDDO - WRITE (7,16) + IF(MYRANK.EQ.0) WRITE (7,16) CALL PPLOT (2) IF(DEBUG)CALL DEPPLT C @@ -1971,7 +1989,7 @@ C DO L=2,LA PAM(L)=SAL(L,KK) ENDDO - WRITE (7,316) KK + IF(MYRANK.EQ.0) WRITE (7,316) KK CALL PPLOT (1) ENDDO 16 FORMAT (1H1,' CELL CENTER STATIC DEPTHS',//) @@ -1994,19 +2012,17 @@ C C ** INITIALIZE EFDC EXPLORER OUTPUT C IF(IBIN_TYPE.EQ.1)THEN - STOP "Unsupported setting: 'IBIN_TYPE=1'" + IF(MYRANK.EQ.0) WRITE(88,*) 'EEXPOUT_mpi(init)' + IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT_mpi(1) ELSEIF(IBIN_TYPE.EQ.0)THEN - IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT(1) - ELSE - WRITE(6, *) "Uknown IBIN_TYPE: ", IBIN_TYPE - WRITE(6, *) "Only supports: IBIN_TYPE = 0, 1" - STOP + IF(MYRANK.EQ.0) WRITE(88,*) 'EEXPOUT_opt_mpi(init)' + IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT_opt_mpi(1) ENDIF ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 C ** INITIALIZE EFDC HYDRO DISTRIBUTION OUTPUT - IF(ISRESTO.LT.-20)THEN - CALL RESTOUT(-20) - ENDIF +! IF(ISRESTO.LT.-20)THEN +! CALL RESTOUT(-20) +! ENDIF ! } GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 C C ** SELECT FULL HYDRODYNAMIC AND MASS TRANSPORT CALCULATION OR @@ -2015,8 +2031,14 @@ C NITERAT=0 C IF(ISLTMT.EQ.0)THEN C IF(IS1DCHAN.EQ.0)THEN + IF(MYRANK.EQ.0) THEN + IF(IS2TIM.EQ.0) PRINT*, "HDMT" + IF(IS2TIM.GE.1.AND.TRIM(MPI_ARG).EQ.'SERL')PRINT*,"HDMT2T" + IF(IS2TIM.GE.1.AND.TRIM(MPI_ARG).EQ.'PARL')PRINT*,"HDMT2T_mpi" + ENDIF IF(IS2TIM.EQ.0) CALL HDMT - IF(IS2TIM.GE.1) CALL HDMT2T + IF(IS2TIM.GE.1.AND.TRIM(MPI_ARG).EQ.'SERL')CALL HDMT2T + IF(IS2TIM.GE.1.AND.TRIM(MPI_ARG).EQ.'PARL')CALL HDMT2T_mpi C ENDIF C IF(IS1DCHAN.GE.1) CALL HDMT1D C ENDIF @@ -2057,6 +2079,7 @@ C TWQDIF=TWQDIF/3600. TWQKIN=TWQKIN/3600. TWQSED=TWQSED/3600. + IF(MYRANK.EQ.0)THEN WRITE(6,1995)THDMT,TCONG IF( NSEDFLUME==0 )THEN WRITE(6,1996)TPUV,TSSED @@ -2073,6 +2096,7 @@ C ENDIF WRITE(6,2003)CPUTIME(1),CPUTIME(2) WRITE(6,2004)TIME_END, TCPU + ENDIF 1995 FORMAT('***TIMING (HOURS)',/, & 'T HDMT =',F7.3,' T CONG GRAD =',F7.3) 1996 FORMAT('T P&UV VELS =',F7.3,' T SSEDTOX =',F7.3) @@ -2087,6 +2111,7 @@ C 2005 FORMAT('T P&UV VELS =',F7.3,' T SEDZLJ =',F7.3) ! *** EFDC LOG + IF(MYRANK.EQ.0)THEN WRITE(8,1995)THDMT,TCONG IF( NSEDFLUME==0 )THEN WRITE(8,1996)TPUV,TSSED @@ -2139,6 +2164,7 @@ C CLOSE(7) CLOSE(8) CLOSE(9) + ENDIF C***** Added By Meng Xia, Nov.19,2007 @@ -2153,6 +2179,8 @@ CPMC END IF CPMC END IF C***** Added By Meng Xia, Nov.19,2007 + CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) + !CALL MPI_FINALIZE(MPI_COMM_WORLD,IERR) STOP END From 1f038d02d6b19faa920a11d705e04ab382d41370 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 13:04:45 +0200 Subject: [PATCH 74/77] Call CALBUOY_mpi --- .../native/efdc_fortran_dll/openDA_wrapper/model_init_3.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for index 39228d43e..2ee59d408 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for @@ -714,7 +714,7 @@ C C C ** INITIALIZE BUOYANCY AND EQUATION OF STATE C - CALL CALBUOY + CALL CALBUOY_mpi C C ** INITIALIZE SFL IF(ISRESTI.EQ.0.AND ISTRAN(4).GE.1) C From 3c7006ad5a49bc78452edc1a48991859e82821e4 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 28 May 2024 13:14:11 +0200 Subject: [PATCH 75/77] Update solution --- .../opendabridge/opendabridge.vcxproj | 8 ++--- .../efdc_fortran_dll/EfdcFortranDLL.vfproj | 30 +++++++++---------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/core/native/build_visual_studio/opendabridge/opendabridge.vcxproj b/core/native/build_visual_studio/opendabridge/opendabridge.vcxproj index b40b0e53a..4874a5620 100644 --- a/core/native/build_visual_studio/opendabridge/opendabridge.vcxproj +++ b/core/native/build_visual_studio/opendabridge/opendabridge.vcxproj @@ -32,28 +32,28 @@ true false Unicode - v142 + v143 DynamicLibrary true false Unicode - v142 + v143 DynamicLibrary false false Unicode - v142 + v143 DynamicLibrary false false Unicode - v142 + v143 diff --git a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj index 539ca477f..9408f275f 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj +++ b/model_efdc_dll/native/efdc_fortran_dll/EfdcFortranDLL.vfproj @@ -83,7 +83,7 @@ - + @@ -94,7 +94,7 @@ - + @@ -116,7 +116,7 @@ - + @@ -170,16 +170,16 @@ - - - + - + + + @@ -196,16 +196,16 @@ - - - + - + + + @@ -213,16 +213,16 @@ - - - + - + + + From f74338298d8dbcf1effe75ccb8707898c6147838 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Mon, 9 Dec 2024 13:13:26 +0100 Subject: [PATCH 76/77] Fix issue with EE_WC.OUT not being created --- .../native/efdc_fortran_dll/openDA_wrapper/model_init_3.for | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for index 2ee59d408..1afa939b8 100644 --- a/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for +++ b/model_efdc_dll/native/efdc_fortran_dll/openDA_wrapper/model_init_3.for @@ -1126,7 +1126,7 @@ C IF(IBIN_TYPE.EQ.1)THEN IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT_mpi(1) ELSEIF(IBIN_TYPE.EQ.0)THEN - IF(ISSPH(8).EQ.0.OR.ISBEXP.EQ.1) CALL EEXPOUT_opt_mpi(1) + IF(ISSPH(8).EQ.1.OR.ISBEXP.EQ.1) CALL EEXPOUT_opt_mpi(1) ENDIF ! { GEOSR WRITE HYDRO FIELD FOR WQ ALONE : JGCHO 2010.11.10 C ** INITIALIZE EFDC HYDRO DISTRIBUTION OUTPUT From b7e5c8661943a8ce0d06cc049e536a5d6ed5c314 Mon Sep 17 00:00:00 2001 From: Werner Kramer Date: Tue, 10 Dec 2024 09:56:48 +0100 Subject: [PATCH 77/77] Rename solution --- .../native/{EFDCFortranDLL2012.sln => EFDCFortranDLL2022.sln} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename model_efdc_dll/native/{EFDCFortranDLL2012.sln => EFDCFortranDLL2022.sln} (100%) diff --git a/model_efdc_dll/native/EFDCFortranDLL2012.sln b/model_efdc_dll/native/EFDCFortranDLL2022.sln similarity index 100% rename from model_efdc_dll/native/EFDCFortranDLL2012.sln rename to model_efdc_dll/native/EFDCFortranDLL2022.sln