From 6d36cb56b5c2557735ec00d5bf0d915164e346aa Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Tue, 6 Dec 2022 11:52:43 +0100 Subject: [PATCH 1/3] 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 2166c0e0c3e12c24a5622553aeeceb9e0335fe3d Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 12 Dec 2022 13:59:14 +0100 Subject: [PATCH 2/3] 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 a06b51291f41838815710f4577bfe3a6b47af380 Mon Sep 17 00:00:00 2001 From: Max van der Kolk Date: Mon, 12 Dec 2022 14:42:12 +0100 Subject: [PATCH 3/3] 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